fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Now ipk_4 and lpk_=4|8 both works. Still need some reworking for i8l8.

Browse Source
ILmat
Salvatore Filippone 8 years ago
parent a441938861
commit c272444e32
15 changed files with 419 additions and 398 deletions
Show Stats Download Patch File Download Diff File

6
base/modules/Makefile
Unescape Escape View File

@ -65,7 +65,7 @@ UTIL_MODS = auxil/psb_string_mod.o desc/psb_desc_const_mod.o desc/psb_indx_map_m
psblas/psb_s_psblas_mod.o psblas/psb_c_psblas_mod.o \ psblas/psb_s_psblas_mod.o psblas/psb_c_psblas_mod.o \
psblas/psb_d_psblas_mod.o psblas/psb_z_psblas_mod.o \ psblas/psb_d_psblas_mod.o psblas/psb_z_psblas_mod.o \
psblas/psb_psblas_mod.o \ psblas/psb_psblas_mod.o \
auxil/psi_serial_mod.o auxil/psi_i_serial_mod.o auxil/psi_l_serial_mod.o \ auxil/psi_serial_mod.o auxil/psi_m_serial_mod.o auxil/psi_e_serial_mod.o \
auxil/psi_s_serial_mod.o auxil/psi_d_serial_mod.o \ auxil/psi_s_serial_mod.o auxil/psi_d_serial_mod.o \
auxil/psi_c_serial_mod.o auxil/psi_z_serial_mod.o \ auxil/psi_c_serial_mod.o auxil/psi_z_serial_mod.o \
psi_mod.o psi_i_mod.o psi_l_mod.o psi_s_mod.o psi_d_mod.o psi_c_mod.o psi_z_mod.o\ psi_mod.o psi_i_mod.o psi_l_mod.o psi_s_mod.o psi_d_mod.o psi_c_mod.o psi_z_mod.o\
@ -185,9 +185,9 @@ auxil/psb_d_hsort_x_mod.o: auxil/psb_d_hsort_mod.o
auxil/psb_c_hsort_x_mod.o: auxil/psb_c_hsort_mod.o auxil/psb_c_hsort_x_mod.o: auxil/psb_c_hsort_mod.o
auxil/psb_z_hsort_x_mod.o: auxil/psb_z_hsort_mod.o auxil/psb_z_hsort_x_mod.o: auxil/psb_z_hsort_mod.o
auxil/psi_serial_mod.o: auxil/psi_i_serial_mod.o auxil/psi_l_serial_mod.o \ auxil/psi_serial_mod.o: auxil/psi_m_serial_mod.o auxil/psi_e_serial_mod.o \
auxil/psi_s_serial_mod.o auxil/psi_d_serial_mod.o auxil/psi_c_serial_mod.o auxil/psi_z_serial_mod.o auxil/psi_s_serial_mod.o auxil/psi_d_serial_mod.o auxil/psi_c_serial_mod.o auxil/psi_z_serial_mod.o
auxil/psi_i_serial_mod.o auxil/psi_l_serial_mod.o auxil/psi_s_serial_mod.o auxil/psi_d_serial_mod.o auxil/psi_c_serial_mod.o auxil/psi_z_serial_mod.o: psb_const_mod.o auxil/psi_m_serial_mod.o auxil/psi_e_serial_mod.o auxil/psi_s_serial_mod.o auxil/psi_d_serial_mod.o auxil/psi_c_serial_mod.o auxil/psi_z_serial_mod.o: psb_const_mod.o
auxil/psb_ip_reord_mod.o: auxil/psb_m_ip_reord_mod.o auxil/psb_e_ip_reord_mod.o \ auxil/psb_ip_reord_mod.o: auxil/psb_m_ip_reord_mod.o auxil/psb_e_ip_reord_mod.o \
auxil/psb_s_ip_reord_mod.o auxil/psb_d_ip_reord_mod.o \ auxil/psb_s_ip_reord_mod.o auxil/psb_d_ip_reord_mod.o \

29
base/modules/auxil/psb_hash_mod.f90 → base/modules/auxil/psb_hash_mod.F90
Unescape Escape View File

@ -67,25 +67,42 @@ module psb_hash_mod
& HashFreeEntry = -1, HashNotFound = -256 & HashFreeEntry = -1, HashNotFound = -256
interface psb_hash_init interface psb_hash_init
module procedure psb_hash_init_v, psb_hash_init_n, & module procedure psb_hash_init_lv, psb_hash_init_ln
& psb_hash_init_lv, psb_hash_init_ln end interface psb_hash_init
end interface
interface psb_sizeof interface psb_sizeof
module procedure psb_sizeof_hash_type module procedure psb_sizeof_hash_type
end interface end interface
interface hashval interface hashval
module procedure ihashval, lhashval module procedure lhashval
end interface hashval
interface psb_hash_searchinskey
module procedure psb_hash_lsearchinskey
end interface psb_hash_searchinskey
interface psb_hash_searchkey
module procedure psb_hash_lsearchkey
end interface psb_hash_searchkey
#if defined (INT_I4_L8)
interface psb_hash_init
module procedure psb_hash_init_v, psb_hash_init_n
end interface
interface hashval
module procedure ihashval
end interface hashval end interface hashval
interface psb_hash_searchinskey interface psb_hash_searchinskey
module procedure psb_hash_searchinskey, psb_hash_lsearchinskey module procedure psb_hash_searchinskey
end interface psb_hash_searchinskey end interface psb_hash_searchinskey
interface psb_hash_searchkey interface psb_hash_searchkey
module procedure psb_hash_searchkey, psb_hash_lsearchkey module procedure psb_hash_searchkey
end interface psb_hash_searchkey end interface psb_hash_searchkey
#endif
interface psb_move_alloc interface psb_move_alloc
module procedure HashTransfer module procedure HashTransfer

2
base/modules/auxil/psi_c_serial_mod.f90
Unescape Escape View File

@ -30,7 +30,7 @@
! !
! !
module psi_c_serial_mod module psi_c_serial_mod
use psb_const_mod, only : psb_ipk_, psb_spk_ use psb_const_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_, psb_spk_
interface psb_gelp interface psb_gelp
! 2-D version ! 2-D version

2
base/modules/auxil/psi_d_serial_mod.f90
Unescape Escape View File

@ -30,7 +30,7 @@
! !
! !
module psi_d_serial_mod module psi_d_serial_mod
use psb_const_mod, only : psb_ipk_, psb_dpk_ use psb_const_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_, psb_dpk_
interface psb_gelp interface psb_gelp
! 2-D version ! 2-D version

110
base/modules/auxil/psi_i_serial_mod.f90 → base/modules/auxil/psi_e_serial_mod.f90
Unescape Escape View File

@ -29,105 +29,105 @@
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
module psi_i_serial_mod module psi_e_serial_mod
use psb_const_mod, only : psb_ipk_, psb_lpk_ use psb_const_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_
interface psb_gelp interface psb_gelp
! 2-D version ! 2-D version
subroutine psb_igelp(trans,iperm,x,info) subroutine psb_egelp(trans,iperm,x,info)
import :: psb_ipk_, psb_lpk_ import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none implicit none
integer(psb_ipk_), intent(inout) :: x(:,:) integer(psb_epk_), intent(inout) :: x(:,:)
integer(psb_ipk_), intent(in) :: iperm(:) integer(psb_ipk_), intent(in) :: iperm(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in) :: trans character, intent(in) :: trans
end subroutine psb_igelp end subroutine psb_egelp
subroutine psb_igelpv(trans,iperm,x,info) subroutine psb_egelpv(trans,iperm,x,info)
import :: psb_ipk_, psb_lpk_ import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none implicit none
integer(psb_ipk_), intent(inout) :: x(:) integer(psb_epk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: iperm(:) integer(psb_ipk_), intent(in) :: iperm(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in) :: trans character, intent(in) :: trans
end subroutine psb_igelpv end subroutine psb_egelpv
end interface psb_gelp end interface psb_gelp
interface psb_geaxpby interface psb_geaxpby
subroutine psi_iaxpby(m,n,alpha, x, beta, y, info) subroutine psi_eaxpby(m,n,alpha, x, beta, y, info)
import :: psb_ipk_, psb_lpk_ import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none implicit none
integer(psb_ipk_), intent(in) :: m, n integer(psb_ipk_), intent(in) :: m, n
integer(psb_ipk_), intent (in) :: x(:,:) integer(psb_epk_), intent (in) :: x(:,:)
integer(psb_ipk_), intent (inout) :: y(:,:) integer(psb_epk_), intent (inout) :: y(:,:)
integer(psb_ipk_), intent (in) :: alpha, beta integer(psb_epk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psi_iaxpby end subroutine psi_eaxpby
subroutine psi_iaxpbyv(m,alpha, x, beta, y, info) subroutine psi_eaxpbyv(m,alpha, x, beta, y, info)
import :: psb_ipk_, psb_lpk_ import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none implicit none
integer(psb_ipk_), intent(in) :: m integer(psb_ipk_), intent(in) :: m
integer(psb_ipk_), intent (in) :: x(:) integer(psb_epk_), intent (in) :: x(:)
integer(psb_ipk_), intent (inout) :: y(:) integer(psb_epk_), intent (inout) :: y(:)
integer(psb_ipk_), intent (in) :: alpha, beta integer(psb_epk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psi_iaxpbyv end subroutine psi_eaxpbyv
end interface psb_geaxpby end interface psb_geaxpby
interface psi_gth interface psi_gth
subroutine psi_igthmv(n,k,idx,alpha,x,beta,y) subroutine psi_egthmv(n,k,idx,alpha,x,beta,y)
import :: psb_ipk_, psb_lpk_ import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none implicit none
integer(psb_ipk_) :: n, k, idx(:) integer(psb_ipk_) :: n, k, idx(:)
integer(psb_ipk_) :: x(:,:), y(:),alpha,beta integer(psb_epk_) :: x(:,:), y(:),alpha,beta
end subroutine psi_igthmv end subroutine psi_egthmv
subroutine psi_igthv(n,idx,alpha,x,beta,y) subroutine psi_egthv(n,idx,alpha,x,beta,y)
import :: psb_ipk_, psb_lpk_ import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none implicit none
integer(psb_ipk_) :: n, idx(:) integer(psb_ipk_) :: n, idx(:)
integer(psb_ipk_) :: x(:), y(:),alpha,beta integer(psb_epk_) :: x(:), y(:),alpha,beta
end subroutine psi_igthv end subroutine psi_egthv
subroutine psi_igthzmv(n,k,idx,x,y) subroutine psi_egthzmv(n,k,idx,x,y)
import :: psb_ipk_, psb_lpk_ import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none implicit none
integer(psb_ipk_) :: n, k, idx(:) integer(psb_ipk_) :: n, k, idx(:)
integer(psb_ipk_) :: x(:,:), y(:) integer(psb_epk_) :: x(:,:), y(:)
end subroutine psi_igthzmv end subroutine psi_egthzmv
subroutine psi_igthzmm(n,k,idx,x,y) subroutine psi_egthzmm(n,k,idx,x,y)
import :: psb_ipk_, psb_lpk_ import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none implicit none
integer(psb_ipk_) :: n, k, idx(:) integer(psb_ipk_) :: n, k, idx(:)
integer(psb_ipk_) :: x(:,:), y(:,:) integer(psb_epk_) :: x(:,:), y(:,:)
end subroutine psi_igthzmm end subroutine psi_egthzmm
subroutine psi_igthzv(n,idx,x,y) subroutine psi_egthzv(n,idx,x,y)
import :: psb_ipk_, psb_lpk_ import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none implicit none
integer(psb_ipk_) :: n, idx(:) integer(psb_ipk_) :: n, idx(:)
integer(psb_ipk_) :: x(:), y(:) integer(psb_epk_) :: x(:), y(:)
end subroutine psi_igthzv end subroutine psi_egthzv
end interface psi_gth end interface psi_gth
interface psi_sct interface psi_sct
subroutine psi_isctmm(n,k,idx,x,beta,y) subroutine psi_esctmm(n,k,idx,x,beta,y)
import :: psb_ipk_, psb_lpk_ import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none implicit none
integer(psb_ipk_) :: n, k, idx(:) integer(psb_ipk_) :: n, k, idx(:)
integer(psb_ipk_) :: beta, x(:,:), y(:,:) integer(psb_epk_) :: beta, x(:,:), y(:,:)
end subroutine psi_isctmm end subroutine psi_esctmm
subroutine psi_isctmv(n,k,idx,x,beta,y) subroutine psi_esctmv(n,k,idx,x,beta,y)
import :: psb_ipk_, psb_lpk_ import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none implicit none
integer(psb_ipk_) :: n, k, idx(:) integer(psb_ipk_) :: n, k, idx(:)
integer(psb_ipk_) :: beta, x(:), y(:,:) integer(psb_epk_) :: beta, x(:), y(:,:)
end subroutine psi_isctmv end subroutine psi_esctmv
subroutine psi_isctv(n,idx,x,beta,y) subroutine psi_esctv(n,idx,x,beta,y)
import :: psb_ipk_, psb_lpk_ import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none implicit none
integer(psb_ipk_) :: n, idx(:) integer(psb_ipk_) :: n, idx(:)
integer(psb_ipk_) :: beta, x(:), y(:) integer(psb_epk_) :: beta, x(:), y(:)
end subroutine psi_isctv end subroutine psi_esctv
end interface psi_sct end interface psi_sct
end module psi_i_serial_mod end module psi_e_serial_mod

110
base/modules/auxil/psi_l_serial_mod.f90 → base/modules/auxil/psi_m_serial_mod.f90
Unescape Escape View File

@ -29,105 +29,105 @@
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
module psi_l_serial_mod module psi_m_serial_mod
use psb_const_mod, only : psb_ipk_, psb_lpk_ use psb_const_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_
interface psb_gelp interface psb_gelp
! 2-D version ! 2-D version
subroutine psb_lgelp(trans,iperm,x,info) subroutine psb_mgelp(trans,iperm,x,info)
import :: psb_ipk_, psb_lpk_ import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none implicit none
integer(psb_lpk_), intent(inout) :: x(:,:) integer(psb_mpk_), intent(inout) :: x(:,:)
integer(psb_ipk_), intent(in) :: iperm(:) integer(psb_ipk_), intent(in) :: iperm(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in) :: trans character, intent(in) :: trans
end subroutine psb_lgelp end subroutine psb_mgelp
subroutine psb_lgelpv(trans,iperm,x,info) subroutine psb_mgelpv(trans,iperm,x,info)
import :: psb_ipk_, psb_lpk_ import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none implicit none
integer(psb_lpk_), intent(inout) :: x(:) integer(psb_mpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: iperm(:) integer(psb_ipk_), intent(in) :: iperm(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character, intent(in) :: trans character, intent(in) :: trans
end subroutine psb_lgelpv end subroutine psb_mgelpv
end interface psb_gelp end interface psb_gelp
interface psb_geaxpby interface psb_geaxpby
subroutine psi_laxpby(m,n,alpha, x, beta, y, info) subroutine psi_maxpby(m,n,alpha, x, beta, y, info)
import :: psb_ipk_, psb_lpk_ import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none implicit none
integer(psb_ipk_), intent(in) :: m, n integer(psb_ipk_), intent(in) :: m, n
integer(psb_lpk_), intent (in) :: x(:,:) integer(psb_mpk_), intent (in) :: x(:,:)
integer(psb_lpk_), intent (inout) :: y(:,:) integer(psb_mpk_), intent (inout) :: y(:,:)
integer(psb_lpk_), intent (in) :: alpha, beta integer(psb_mpk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psi_laxpby end subroutine psi_maxpby
subroutine psi_laxpbyv(m,alpha, x, beta, y, info) subroutine psi_maxpbyv(m,alpha, x, beta, y, info)
import :: psb_ipk_, psb_lpk_ import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none implicit none
integer(psb_ipk_), intent(in) :: m integer(psb_ipk_), intent(in) :: m
integer(psb_lpk_), intent (in) :: x(:) integer(psb_mpk_), intent (in) :: x(:)
integer(psb_lpk_), intent (inout) :: y(:) integer(psb_mpk_), intent (inout) :: y(:)
integer(psb_lpk_), intent (in) :: alpha, beta integer(psb_mpk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psi_laxpbyv end subroutine psi_maxpbyv
end interface psb_geaxpby end interface psb_geaxpby
interface psi_gth interface psi_gth
subroutine psi_lgthmv(n,k,idx,alpha,x,beta,y) subroutine psi_mgthmv(n,k,idx,alpha,x,beta,y)
import :: psb_ipk_, psb_lpk_ import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none implicit none
integer(psb_ipk_) :: n, k, idx(:) integer(psb_ipk_) :: n, k, idx(:)
integer(psb_lpk_) :: x(:,:), y(:),alpha,beta integer(psb_mpk_) :: x(:,:), y(:),alpha,beta
end subroutine psi_lgthmv end subroutine psi_mgthmv
subroutine psi_lgthv(n,idx,alpha,x,beta,y) subroutine psi_mgthv(n,idx,alpha,x,beta,y)
import :: psb_ipk_, psb_lpk_ import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none implicit none
integer(psb_ipk_) :: n, idx(:) integer(psb_ipk_) :: n, idx(:)
integer(psb_lpk_) :: x(:), y(:),alpha,beta integer(psb_mpk_) :: x(:), y(:),alpha,beta
end subroutine psi_lgthv end subroutine psi_mgthv
subroutine psi_lgthzmv(n,k,idx,x,y) subroutine psi_mgthzmv(n,k,idx,x,y)
import :: psb_ipk_, psb_lpk_ import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none implicit none
integer(psb_ipk_) :: n, k, idx(:) integer(psb_ipk_) :: n, k, idx(:)
integer(psb_lpk_) :: x(:,:), y(:) integer(psb_mpk_) :: x(:,:), y(:)
end subroutine psi_lgthzmv end subroutine psi_mgthzmv
subroutine psi_lgthzmm(n,k,idx,x,y) subroutine psi_mgthzmm(n,k,idx,x,y)
import :: psb_ipk_, psb_lpk_ import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none implicit none
integer(psb_ipk_) :: n, k, idx(:) integer(psb_ipk_) :: n, k, idx(:)
integer(psb_lpk_) :: x(:,:), y(:,:) integer(psb_mpk_) :: x(:,:), y(:,:)
end subroutine psi_lgthzmm end subroutine psi_mgthzmm
subroutine psi_lgthzv(n,idx,x,y) subroutine psi_mgthzv(n,idx,x,y)
import :: psb_ipk_, psb_lpk_ import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none implicit none
integer(psb_ipk_) :: n, idx(:) integer(psb_ipk_) :: n, idx(:)
integer(psb_lpk_) :: x(:), y(:) integer(psb_mpk_) :: x(:), y(:)
end subroutine psi_lgthzv end subroutine psi_mgthzv
end interface psi_gth end interface psi_gth
interface psi_sct interface psi_sct
subroutine psi_lsctmm(n,k,idx,x,beta,y) subroutine psi_msctmm(n,k,idx,x,beta,y)
import :: psb_ipk_, psb_lpk_ import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none implicit none
integer(psb_ipk_) :: n, k, idx(:) integer(psb_ipk_) :: n, k, idx(:)
integer(psb_lpk_) :: beta, x(:,:), y(:,:) integer(psb_mpk_) :: beta, x(:,:), y(:,:)
end subroutine psi_lsctmm end subroutine psi_msctmm
subroutine psi_lsctmv(n,k,idx,x,beta,y) subroutine psi_msctmv(n,k,idx,x,beta,y)
import :: psb_ipk_, psb_lpk_ import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none implicit none
integer(psb_ipk_) :: n, k, idx(:) integer(psb_ipk_) :: n, k, idx(:)
integer(psb_lpk_) :: beta, x(:), y(:,:) integer(psb_mpk_) :: beta, x(:), y(:,:)
end subroutine psi_lsctmv end subroutine psi_msctmv
subroutine psi_lsctv(n,idx,x,beta,y) subroutine psi_msctv(n,idx,x,beta,y)
import :: psb_ipk_, psb_lpk_ import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none implicit none
integer(psb_ipk_) :: n, idx(:) integer(psb_ipk_) :: n, idx(:)
integer(psb_lpk_) :: beta, x(:), y(:) integer(psb_mpk_) :: beta, x(:), y(:)
end subroutine psi_lsctv end subroutine psi_msctv
end interface psi_sct end interface psi_sct
end module psi_l_serial_mod end module psi_m_serial_mod

2
base/modules/auxil/psi_s_serial_mod.f90
Unescape Escape View File

@ -30,7 +30,7 @@
! !
! !
module psi_s_serial_mod module psi_s_serial_mod
use psb_const_mod, only : psb_ipk_, psb_spk_ use psb_const_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_, psb_spk_
interface psb_gelp interface psb_gelp
! 2-D version ! 2-D version

4
base/modules/auxil/psi_serial_mod.f90
Unescape Escape View File

@ -30,8 +30,8 @@
! !
! !
module psi_serial_mod module psi_serial_mod
use psi_i_serial_mod use psi_m_serial_mod
use psi_l_serial_mod use psi_e_serial_mod
use psi_s_serial_mod use psi_s_serial_mod
use psi_d_serial_mod use psi_d_serial_mod
use psi_c_serial_mod use psi_c_serial_mod

2
base/modules/auxil/psi_z_serial_mod.f90
Unescape Escape View File

@ -30,7 +30,7 @@
! !
! !
module psi_z_serial_mod module psi_z_serial_mod
use psb_const_mod, only : psb_ipk_, psb_dpk_ use psb_const_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_, psb_dpk_
interface psb_gelp interface psb_gelp
! 2-D version ! 2-D version

3
base/modules/desc/psb_gen_block_map_mod.f90
Unescape Escape View File

@ -111,7 +111,8 @@ module psb_gen_block_map_mod
& block_get_fmt, gen_block_search, l_gen_block_search & block_get_fmt, gen_block_search, l_gen_block_search
interface gen_block_search interface gen_block_search
module procedure gen_block_search, l_gen_block_search module procedure l_gen_block_search
! module procedure gen_block_search, l_gen_block_search
end interface gen_block_search end interface gen_block_search
integer(psb_ipk_), private :: laddsz=500 integer(psb_ipk_), private :: laddsz=500

7
base/modules/desc/psb_indx_map_mod.f90
Unescape Escape View File

@ -142,12 +142,13 @@ module psb_indx_map_mod
procedure, pass(idxmap) :: get_lr => base_get_lr procedure, pass(idxmap) :: get_lr => base_get_lr
procedure, pass(idxmap) :: get_lc => base_get_lc procedure, pass(idxmap) :: get_lc => base_get_lc
procedure, pass(idxmap) :: set_gri => base_set_gri procedure, pass(idxmap) :: set_gri => base_set_gri
procedure, pass(idxmap) :: set_gci => base_set_gci procedure, pass(idxmap) :: set_gci => base_set_gci
procedure, pass(idxmap) :: set_grl => base_set_grl procedure, pass(idxmap) :: set_grl => base_set_grl
procedure, pass(idxmap) :: set_gcl => base_set_gcl procedure, pass(idxmap) :: set_gcl => base_set_gcl
generic, public :: set_gr => set_gri, set_grl generic, public :: set_gr => set_grl
generic, public :: set_gc => set_gci, set_gcl generic, public :: set_gc => set_gcl
procedure, pass(idxmap) :: set_lr => base_set_lr procedure, pass(idxmap) :: set_lr => base_set_lr
procedure, pass(idxmap) :: set_lc => base_set_lc procedure, pass(idxmap) :: set_lc => base_set_lc
@ -216,7 +217,7 @@ module psb_indx_map_mod
& base_is_upd, base_is_asb, base_is_valid, base_is_ovl,& & base_is_upd, base_is_asb, base_is_valid, base_is_ovl,&
& base_get_gr, base_get_gc, base_get_lr, base_get_lc, base_get_ctxt,& & base_get_gr, base_get_gc, base_get_lr, base_get_lc, base_get_ctxt,&
& base_get_mpic, base_sizeof, base_set_null, & & base_get_mpic, base_sizeof, base_set_null, &
& base_set_gri, base_set_gci, base_set_grl, base_set_gcl, & & base_set_grl, base_set_gcl, &
& base_set_lr, base_set_lc, base_set_ctxt,& & base_set_lr, base_set_lc, base_set_ctxt,&
& base_set_mpic, base_get_fmt, base_asb, base_free,& & base_set_mpic, base_get_fmt, base_asb, base_free,&
& base_l2gs1, base_l2gs2, base_l2gv1, base_l2gv2,& & base_l2gs1, base_l2gs2, base_l2gv1, base_l2gv2,&

2
base/serial/Makefile
Unescape Escape View File

@ -1,7 +1,7 @@
include ../../Make.inc include ../../Make.inc
FOBJS = psb_lsame.o psi_i_serial_impl.o psi_l_serial_impl.o \ FOBJS = psb_lsame.o psi_m_serial_impl.o psi_e_serial_impl.o \
psi_s_serial_impl.o psi_d_serial_impl.o \ psi_s_serial_impl.o psi_d_serial_impl.o \
psi_c_serial_impl.o psi_z_serial_impl.o \ psi_c_serial_impl.o psi_z_serial_impl.o \
psb_srwextd.o psb_drwextd.o psb_crwextd.o psb_zrwextd.o \ psb_srwextd.o psb_drwextd.o psb_crwextd.o psb_zrwextd.o \

166
base/serial/psi_l_serial_impl.f90 → base/serial/psi_e_serial_impl.f90
Unescape Escape View File

@ -29,15 +29,15 @@
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
subroutine psi_laxpby(m,n,alpha, x, beta, y, info) subroutine psi_eaxpby(m,n,alpha, x, beta, y, info)
use psb_const_mod use psb_const_mod
use psb_error_mod use psb_error_mod
implicit none implicit none
integer(psb_ipk_), intent(in) :: m, n integer(psb_ipk_), intent(in) :: m, n
integer(psb_lpk_), intent (in) :: x(:,:) integer(psb_epk_), intent (in) :: x(:,:)
integer(psb_lpk_), intent (inout) :: y(:,:) integer(psb_epk_), intent (inout) :: y(:,:)
integer(psb_lpk_), intent (in) :: alpha, beta integer(psb_epk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: lx, ly integer(psb_ipk_) :: lx, ly
@ -76,7 +76,7 @@ subroutine psi_laxpby(m,n,alpha, x, beta, y, info)
goto 9999 goto 9999
end if end if
if ((m>0).and.(n>0)) call laxpby(m,n,alpha,x,lx,beta,y,ly,info) if ((m>0).and.(n>0)) call eaxpby(m,n,alpha,x,lx,beta,y,ly,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -84,17 +84,17 @@ subroutine psi_laxpby(m,n,alpha, x, beta, y, info)
9999 call psb_error_handler(err_act) 9999 call psb_error_handler(err_act)
return return
end subroutine psi_laxpby end subroutine psi_eaxpby
subroutine psi_laxpbyv(m,alpha, x, beta, y, info) subroutine psi_eaxpbyv(m,alpha, x, beta, y, info)
use psb_const_mod use psb_const_mod
use psb_error_mod use psb_error_mod
implicit none implicit none
integer(psb_ipk_), intent(in) :: m integer(psb_ipk_), intent(in) :: m
integer(psb_lpk_), intent (in) :: x(:) integer(psb_epk_), intent (in) :: x(:)
integer(psb_lpk_), intent (inout) :: y(:) integer(psb_epk_), intent (inout) :: y(:)
integer(psb_lpk_), intent (in) :: alpha, beta integer(psb_epk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: lx, ly integer(psb_ipk_) :: lx, ly
@ -127,7 +127,7 @@ subroutine psi_laxpbyv(m,alpha, x, beta, y, info)
goto 9999 goto 9999
end if end if
if (m>0) call laxpby(m,ione,alpha,x,lx,beta,y,ly,info) if (m>0) call eaxpby(m,ione,alpha,x,lx,beta,y,ly,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -136,30 +136,30 @@ subroutine psi_laxpbyv(m,alpha, x, beta, y, info)
return return
end subroutine psi_laxpbyv end subroutine psi_eaxpbyv
subroutine psi_lgthmv(n,k,idx,alpha,x,beta,y) subroutine psi_egthmv(n,k,idx,alpha,x,beta,y)
use psb_const_mod use psb_const_mod
implicit none implicit none
integer(psb_ipk_) :: n, k, idx(:) integer(psb_ipk_) :: n, k, idx(:)
integer(psb_lpk_) :: x(:,:), y(:),alpha,beta integer(psb_epk_) :: x(:,:), y(:),alpha,beta
! Locals ! Locals
integer(psb_ipk_) :: i, j, pt integer(psb_ipk_) :: i, j, pt
if (beta == lzero) then if (beta == ezero) then
if (alpha == lzero) then if (alpha == ezero) then
pt=0 pt=0
do j=1,k do j=1,k
do i=1,n do i=1,n
pt=pt+1 pt=pt+1
y(pt) = lzero y(pt) = ezero
end do end do
end do end do
else if (alpha == lone) then else if (alpha == eone) then
pt=0 pt=0
do j=1,k do j=1,k
do i=1,n do i=1,n
@ -167,7 +167,7 @@ subroutine psi_lgthmv(n,k,idx,alpha,x,beta,y)
y(pt) = x(idx(i),j) y(pt) = x(idx(i),j)
end do end do
end do end do
else if (alpha == -lone) then else if (alpha == -eone) then
pt=0 pt=0
do j=1,k do j=1,k
do i=1,n do i=1,n
@ -185,17 +185,17 @@ subroutine psi_lgthmv(n,k,idx,alpha,x,beta,y)
end do end do
end if end if
else else
if (beta == lone) then if (beta == eone) then
! Do nothing ! Do nothing
else if (beta == -lone) then else if (beta == -eone) then
y(1:n*k) = -y(1:n*k) y(1:n*k) = -y(1:n*k)
else else
y(1:n*k) = beta*y(1:n*k) y(1:n*k) = beta*y(1:n*k)
end if end if
if (alpha == lzero) then if (alpha == ezero) then
! do nothing ! do nothing
else if (alpha == lone) then else if (alpha == eone) then
pt=0 pt=0
do j=1,k do j=1,k
do i=1,n do i=1,n
@ -203,7 +203,7 @@ subroutine psi_lgthmv(n,k,idx,alpha,x,beta,y)
y(pt) = y(pt) + x(idx(i),j) y(pt) = y(pt) + x(idx(i),j)
end do end do
end do end do
else if (alpha == -lone) then else if (alpha == -eone) then
pt=0 pt=0
do j=1,k do j=1,k
do i=1,n do i=1,n
@ -222,28 +222,28 @@ subroutine psi_lgthmv(n,k,idx,alpha,x,beta,y)
end if end if
end if end if
end subroutine psi_lgthmv end subroutine psi_egthmv
subroutine psi_lgthv(n,idx,alpha,x,beta,y) subroutine psi_egthv(n,idx,alpha,x,beta,y)
use psb_const_mod use psb_const_mod
implicit none implicit none
integer(psb_ipk_) :: n, idx(:) integer(psb_ipk_) :: n, idx(:)
integer(psb_lpk_) :: x(:), y(:),alpha,beta integer(psb_epk_) :: x(:), y(:),alpha,beta
! Locals ! Locals
integer(psb_ipk_) :: i integer(psb_ipk_) :: i
if (beta == lzero) then if (beta == ezero) then
if (alpha == lzero) then if (alpha == ezero) then
do i=1,n do i=1,n
y(i) = lzero y(i) = ezero
end do end do
else if (alpha == lone) then else if (alpha == eone) then
do i=1,n do i=1,n
y(i) = x(idx(i)) y(i) = x(idx(i))
end do end do
else if (alpha == -lone) then else if (alpha == -eone) then
do i=1,n do i=1,n
y(i) = -x(idx(i)) y(i) = -x(idx(i))
end do end do
@ -253,21 +253,21 @@ subroutine psi_lgthv(n,idx,alpha,x,beta,y)
end do end do
end if end if
else else
if (beta == lone) then if (beta == eone) then
! Do nothing ! Do nothing
else if (beta == -lone) then else if (beta == -eone) then
y(1:n) = -y(1:n) y(1:n) = -y(1:n)
else else
y(1:n) = beta*y(1:n) y(1:n) = beta*y(1:n)
end if end if
if (alpha == lzero) then if (alpha == ezero) then
! do nothing ! do nothing
else if (alpha == lone) then else if (alpha == eone) then
do i=1,n do i=1,n
y(i) = y(i) + x(idx(i)) y(i) = y(i) + x(idx(i))
end do end do
else if (alpha == -lone) then else if (alpha == -eone) then
do i=1,n do i=1,n
y(i) = y(i) - x(idx(i)) y(i) = y(i) - x(idx(i))
end do end do
@ -278,15 +278,15 @@ subroutine psi_lgthv(n,idx,alpha,x,beta,y)
end if end if
end if end if
end subroutine psi_lgthv end subroutine psi_egthv
subroutine psi_lgthzmm(n,k,idx,x,y) subroutine psi_egthzmm(n,k,idx,x,y)
use psb_const_mod use psb_const_mod
implicit none implicit none
integer(psb_ipk_) :: n, k, idx(:) integer(psb_ipk_) :: n, k, idx(:)
integer(psb_lpk_) :: x(:,:), y(:,:) integer(psb_epk_) :: x(:,:), y(:,:)
! Locals ! Locals
integer(psb_ipk_) :: i integer(psb_ipk_) :: i
@ -296,15 +296,15 @@ subroutine psi_lgthzmm(n,k,idx,x,y)
y(i,1:k)=x(idx(i),1:k) y(i,1:k)=x(idx(i),1:k)
end do end do
end subroutine psi_lgthzmm end subroutine psi_egthzmm
subroutine psi_lgthzmv(n,k,idx,x,y) subroutine psi_egthzmv(n,k,idx,x,y)
use psb_const_mod use psb_const_mod
implicit none implicit none
integer(psb_ipk_) :: n, k, idx(:) integer(psb_ipk_) :: n, k, idx(:)
integer(psb_lpk_) :: x(:,:), y(:) integer(psb_epk_) :: x(:,:), y(:)
! Locals ! Locals
integer(psb_ipk_) :: i, j, pt integer(psb_ipk_) :: i, j, pt
@ -317,15 +317,15 @@ subroutine psi_lgthzmv(n,k,idx,x,y)
end do end do
end do end do
end subroutine psi_lgthzmv end subroutine psi_egthzmv
subroutine psi_lgthzv(n,idx,x,y) subroutine psi_egthzv(n,idx,x,y)
use psb_const_mod use psb_const_mod
implicit none implicit none
integer(psb_ipk_) :: n, idx(:) integer(psb_ipk_) :: n, idx(:)
integer(psb_lpk_) :: x(:), y(:) integer(psb_epk_) :: x(:), y(:)
! Locals ! Locals
integer(psb_ipk_) :: i integer(psb_ipk_) :: i
@ -334,24 +334,24 @@ subroutine psi_lgthzv(n,idx,x,y)
y(i)=x(idx(i)) y(i)=x(idx(i))
end do end do
end subroutine psi_lgthzv end subroutine psi_egthzv
subroutine psi_lsctmm(n,k,idx,x,beta,y) subroutine psi_esctmm(n,k,idx,x,beta,y)
use psb_const_mod use psb_const_mod
implicit none implicit none
integer(psb_ipk_) :: n, k, idx(:) integer(psb_ipk_) :: n, k, idx(:)
integer(psb_lpk_) :: beta, x(:,:), y(:,:) integer(psb_epk_) :: beta, x(:,:), y(:,:)
! Locals ! Locals
integer(psb_ipk_) :: i, j integer(psb_ipk_) :: i, j
if (beta == lzero) then if (beta == ezero) then
do i=1,n do i=1,n
y(idx(i),1:k) = x(i,1:k) y(idx(i),1:k) = x(i,1:k)
end do end do
else if (beta == lone) then else if (beta == eone) then
do i=1,n do i=1,n
y(idx(i),1:k) = y(idx(i),1:k)+x(i,1:k) y(idx(i),1:k) = y(idx(i),1:k)+x(i,1:k)
end do end do
@ -360,20 +360,20 @@ subroutine psi_lsctmm(n,k,idx,x,beta,y)
y(idx(i),1:k) = beta*y(idx(i),1:k)+x(i,1:k) y(idx(i),1:k) = beta*y(idx(i),1:k)+x(i,1:k)
end do end do
end if end if
end subroutine psi_lsctmm end subroutine psi_esctmm
subroutine psi_lsctmv(n,k,idx,x,beta,y) subroutine psi_esctmv(n,k,idx,x,beta,y)
use psb_const_mod use psb_const_mod
implicit none implicit none
integer(psb_ipk_) :: n, k, idx(:) integer(psb_ipk_) :: n, k, idx(:)
integer(psb_lpk_) :: beta, x(:), y(:,:) integer(psb_epk_) :: beta, x(:), y(:,:)
! Locals ! Locals
integer(psb_ipk_) :: i, j, pt integer(psb_ipk_) :: i, j, pt
if (beta == lzero) then if (beta == ezero) then
pt=0 pt=0
do j=1,k do j=1,k
do i=1,n do i=1,n
@ -381,7 +381,7 @@ subroutine psi_lsctmv(n,k,idx,x,beta,y)
y(idx(i),j) = x(pt) y(idx(i),j) = x(pt)
end do end do
end do end do
else if (beta == lone) then else if (beta == eone) then
pt=0 pt=0
do j=1,k do j=1,k
do i=1,n do i=1,n
@ -398,24 +398,24 @@ subroutine psi_lsctmv(n,k,idx,x,beta,y)
end do end do
end do end do
end if end if
end subroutine psi_lsctmv end subroutine psi_esctmv
subroutine psi_lsctv(n,idx,x,beta,y) subroutine psi_esctv(n,idx,x,beta,y)
use psb_const_mod use psb_const_mod
implicit none implicit none
integer(psb_ipk_) :: n, idx(:) integer(psb_ipk_) :: n, idx(:)
integer(psb_lpk_) :: beta, x(:), y(:) integer(psb_epk_) :: beta, x(:), y(:)
! Locals ! Locals
integer(psb_ipk_) :: i integer(psb_ipk_) :: i
if (beta == lzero) then if (beta == ezero) then
do i=1,n do i=1,n
y(idx(i)) = x(i) y(idx(i)) = x(i)
end do end do
else if (beta == lone) then else if (beta == eone) then
do i=1,n do i=1,n
y(idx(i)) = y(idx(i))+x(i) y(idx(i)) = y(idx(i))+x(i)
end do end do
@ -424,19 +424,19 @@ subroutine psi_lsctv(n,idx,x,beta,y)
y(idx(i)) = beta*y(idx(i))+x(i) y(idx(i)) = beta*y(idx(i))+x(i)
end do end do
end if end if
end subroutine psi_lsctv end subroutine psi_esctv
subroutine laxpby(m, n, alpha, X, lldx, beta, Y, lldy, info) subroutine eaxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
use psb_const_mod use psb_const_mod
use psb_error_mod use psb_error_mod
implicit none implicit none
integer(psb_ipk_) :: n, m, lldx, lldy, info integer(psb_ipk_) :: n, m, lldx, lldy, info
integer(psb_lpk_) X(lldx,*), Y(lldy,*) integer(psb_epk_) X(lldx,*), Y(lldy,*)
integer(psb_lpk_) alpha, beta integer(psb_epk_) alpha, beta
integer(psb_ipk_) :: i, j integer(psb_ipk_) :: i, j
integer(psb_ipk_) :: int_err(5) integer(psb_ipk_) :: int_err(5)
character name*20 character name*20
name='laxpby' name='eaxpby'
! !
@ -473,19 +473,19 @@ subroutine laxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
goto 9999 goto 9999
endif endif
if (alpha.eq.lzero) then if (alpha.eq.ezero) then
if (beta.eq.lzero) then if (beta.eq.ezero) then
do j=1, n do j=1, n
do i=1,m do i=1,m
y(i,j) = lzero y(i,j) = ezero
enddo enddo
enddo enddo
else if (beta.eq.lone) then else if (beta.eq.eone) then
! !
! Do nothing! ! Do nothing!
! !
else if (beta.eq.-lone) then else if (beta.eq.-eone) then
do j=1,n do j=1,n
do i=1,m do i=1,m
y(i,j) = - y(i,j) y(i,j) = - y(i,j)
@ -499,22 +499,22 @@ subroutine laxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
enddo enddo
endif endif
else if (alpha.eq.lone) then else if (alpha.eq.eone) then
if (beta.eq.lzero) then if (beta.eq.ezero) then
do j=1,n do j=1,n
do i=1,m do i=1,m
y(i,j) = x(i,j) y(i,j) = x(i,j)
enddo enddo
enddo enddo
else if (beta.eq.lone) then else if (beta.eq.eone) then
do j=1,n do j=1,n
do i=1,m do i=1,m
y(i,j) = x(i,j) + y(i,j) y(i,j) = x(i,j) + y(i,j)
enddo enddo
enddo enddo
else if (beta.eq.-lone) then else if (beta.eq.-eone) then
do j=1,n do j=1,n
do i=1,m do i=1,m
y(i,j) = x(i,j) - y(i,j) y(i,j) = x(i,j) - y(i,j)
@ -528,22 +528,22 @@ subroutine laxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
enddo enddo
endif endif
else if (alpha.eq.-lone) then else if (alpha.eq.-eone) then
if (beta.eq.lzero) then if (beta.eq.ezero) then
do j=1,n do j=1,n
do i=1,m do i=1,m
y(i,j) = -x(i,j) y(i,j) = -x(i,j)
enddo enddo
enddo enddo
else if (beta.eq.lone) then else if (beta.eq.eone) then
do j=1,n do j=1,n
do i=1,m do i=1,m
y(i,j) = -x(i,j) + y(i,j) y(i,j) = -x(i,j) + y(i,j)
enddo enddo
enddo enddo
else if (beta.eq.-lone) then else if (beta.eq.-eone) then
do j=1,n do j=1,n
do i=1,m do i=1,m
y(i,j) = -x(i,j) - y(i,j) y(i,j) = -x(i,j) - y(i,j)
@ -559,20 +559,20 @@ subroutine laxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
else else
if (beta.eq.lzero) then if (beta.eq.ezero) then
do j=1,n do j=1,n
do i=1,m do i=1,m
y(i,j) = alpha*x(i,j) y(i,j) = alpha*x(i,j)
enddo enddo
enddo enddo
else if (beta.eq.lone) then else if (beta.eq.eone) then
do j=1,n do j=1,n
do i=1,m do i=1,m
y(i,j) = alpha*x(i,j) + y(i,j) y(i,j) = alpha*x(i,j) + y(i,j)
enddo enddo
enddo enddo
else if (beta.eq.-lone) then else if (beta.eq.-eone) then
do j=1,n do j=1,n
do i=1,m do i=1,m
y(i,j) = alpha*x(i,j) - y(i,j) y(i,j) = alpha*x(i,j) - y(i,j)
@ -594,4 +594,4 @@ subroutine laxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
call fcpsb_serror() call fcpsb_serror()
return return
end subroutine laxpby end subroutine eaxpby

166
base/serial/psi_i_serial_impl.f90 → base/serial/psi_m_serial_impl.f90
Unescape Escape View File

@ -29,15 +29,15 @@
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
! !
subroutine psi_iaxpby(m,n,alpha, x, beta, y, info) subroutine psi_maxpby(m,n,alpha, x, beta, y, info)
use psb_const_mod use psb_const_mod
use psb_error_mod use psb_error_mod
implicit none implicit none
integer(psb_ipk_), intent(in) :: m, n integer(psb_ipk_), intent(in) :: m, n
integer(psb_ipk_), intent (in) :: x(:,:) integer(psb_mpk_), intent (in) :: x(:,:)
integer(psb_ipk_), intent (inout) :: y(:,:) integer(psb_mpk_), intent (inout) :: y(:,:)
integer(psb_ipk_), intent (in) :: alpha, beta integer(psb_mpk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: lx, ly integer(psb_ipk_) :: lx, ly
@ -76,7 +76,7 @@ subroutine psi_iaxpby(m,n,alpha, x, beta, y, info)
goto 9999 goto 9999
end if end if
if ((m>0).and.(n>0)) call iaxpby(m,n,alpha,x,lx,beta,y,ly,info) if ((m>0).and.(n>0)) call maxpby(m,n,alpha,x,lx,beta,y,ly,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -84,17 +84,17 @@ subroutine psi_iaxpby(m,n,alpha, x, beta, y, info)
9999 call psb_error_handler(err_act) 9999 call psb_error_handler(err_act)
return return
end subroutine psi_iaxpby end subroutine psi_maxpby
subroutine psi_iaxpbyv(m,alpha, x, beta, y, info) subroutine psi_maxpbyv(m,alpha, x, beta, y, info)
use psb_const_mod use psb_const_mod
use psb_error_mod use psb_error_mod
implicit none implicit none
integer(psb_ipk_), intent(in) :: m integer(psb_ipk_), intent(in) :: m
integer(psb_ipk_), intent (in) :: x(:) integer(psb_mpk_), intent (in) :: x(:)
integer(psb_ipk_), intent (inout) :: y(:) integer(psb_mpk_), intent (inout) :: y(:)
integer(psb_ipk_), intent (in) :: alpha, beta integer(psb_mpk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: lx, ly integer(psb_ipk_) :: lx, ly
@ -127,7 +127,7 @@ subroutine psi_iaxpbyv(m,alpha, x, beta, y, info)
goto 9999 goto 9999
end if end if
if (m>0) call iaxpby(m,ione,alpha,x,lx,beta,y,ly,info) if (m>0) call maxpby(m,ione,alpha,x,lx,beta,y,ly,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -136,30 +136,30 @@ subroutine psi_iaxpbyv(m,alpha, x, beta, y, info)
return return
end subroutine psi_iaxpbyv end subroutine psi_maxpbyv
subroutine psi_igthmv(n,k,idx,alpha,x,beta,y) subroutine psi_mgthmv(n,k,idx,alpha,x,beta,y)
use psb_const_mod use psb_const_mod
implicit none implicit none
integer(psb_ipk_) :: n, k, idx(:) integer(psb_ipk_) :: n, k, idx(:)
integer(psb_ipk_) :: x(:,:), y(:),alpha,beta integer(psb_mpk_) :: x(:,:), y(:),alpha,beta
! Locals ! Locals
integer(psb_ipk_) :: i, j, pt integer(psb_ipk_) :: i, j, pt
if (beta == izero) then if (beta == mzero) then
if (alpha == izero) then if (alpha == mzero) then
pt=0 pt=0
do j=1,k do j=1,k
do i=1,n do i=1,n
pt=pt+1 pt=pt+1
y(pt) = izero y(pt) = mzero
end do end do
end do end do
else if (alpha == ione) then else if (alpha == mone) then
pt=0 pt=0
do j=1,k do j=1,k
do i=1,n do i=1,n
@ -167,7 +167,7 @@ subroutine psi_igthmv(n,k,idx,alpha,x,beta,y)
y(pt) = x(idx(i),j) y(pt) = x(idx(i),j)
end do end do
end do end do
else if (alpha == -ione) then else if (alpha == -mone) then
pt=0 pt=0
do j=1,k do j=1,k
do i=1,n do i=1,n
@ -185,17 +185,17 @@ subroutine psi_igthmv(n,k,idx,alpha,x,beta,y)
end do end do
end if end if
else else
if (beta == ione) then if (beta == mone) then
! Do nothing ! Do nothing
else if (beta == -ione) then else if (beta == -mone) then
y(1:n*k) = -y(1:n*k) y(1:n*k) = -y(1:n*k)
else else
y(1:n*k) = beta*y(1:n*k) y(1:n*k) = beta*y(1:n*k)
end if end if
if (alpha == izero) then if (alpha == mzero) then
! do nothing ! do nothing
else if (alpha == ione) then else if (alpha == mone) then
pt=0 pt=0
do j=1,k do j=1,k
do i=1,n do i=1,n
@ -203,7 +203,7 @@ subroutine psi_igthmv(n,k,idx,alpha,x,beta,y)
y(pt) = y(pt) + x(idx(i),j) y(pt) = y(pt) + x(idx(i),j)
end do end do
end do end do
else if (alpha == -ione) then else if (alpha == -mone) then
pt=0 pt=0
do j=1,k do j=1,k
do i=1,n do i=1,n
@ -222,28 +222,28 @@ subroutine psi_igthmv(n,k,idx,alpha,x,beta,y)
end if end if
end if end if
end subroutine psi_igthmv end subroutine psi_mgthmv
subroutine psi_igthv(n,idx,alpha,x,beta,y) subroutine psi_mgthv(n,idx,alpha,x,beta,y)
use psb_const_mod use psb_const_mod
implicit none implicit none
integer(psb_ipk_) :: n, idx(:) integer(psb_ipk_) :: n, idx(:)
integer(psb_ipk_) :: x(:), y(:),alpha,beta integer(psb_mpk_) :: x(:), y(:),alpha,beta
! Locals ! Locals
integer(psb_ipk_) :: i integer(psb_ipk_) :: i
if (beta == izero) then if (beta == mzero) then
if (alpha == izero) then if (alpha == mzero) then
do i=1,n do i=1,n
y(i) = izero y(i) = mzero
end do end do
else if (alpha == ione) then else if (alpha == mone) then
do i=1,n do i=1,n
y(i) = x(idx(i)) y(i) = x(idx(i))
end do end do
else if (alpha == -ione) then else if (alpha == -mone) then
do i=1,n do i=1,n
y(i) = -x(idx(i)) y(i) = -x(idx(i))
end do end do
@ -253,21 +253,21 @@ subroutine psi_igthv(n,idx,alpha,x,beta,y)
end do end do
end if end if
else else
if (beta == ione) then if (beta == mone) then
! Do nothing ! Do nothing
else if (beta == -ione) then else if (beta == -mone) then
y(1:n) = -y(1:n) y(1:n) = -y(1:n)
else else
y(1:n) = beta*y(1:n) y(1:n) = beta*y(1:n)
end if end if
if (alpha == izero) then if (alpha == mzero) then
! do nothing ! do nothing
else if (alpha == ione) then else if (alpha == mone) then
do i=1,n do i=1,n
y(i) = y(i) + x(idx(i)) y(i) = y(i) + x(idx(i))
end do end do
else if (alpha == -ione) then else if (alpha == -mone) then
do i=1,n do i=1,n
y(i) = y(i) - x(idx(i)) y(i) = y(i) - x(idx(i))
end do end do
@ -278,15 +278,15 @@ subroutine psi_igthv(n,idx,alpha,x,beta,y)
end if end if
end if end if
end subroutine psi_igthv end subroutine psi_mgthv
subroutine psi_igthzmm(n,k,idx,x,y) subroutine psi_mgthzmm(n,k,idx,x,y)
use psb_const_mod use psb_const_mod
implicit none implicit none
integer(psb_ipk_) :: n, k, idx(:) integer(psb_ipk_) :: n, k, idx(:)
integer(psb_ipk_) :: x(:,:), y(:,:) integer(psb_mpk_) :: x(:,:), y(:,:)
! Locals ! Locals
integer(psb_ipk_) :: i integer(psb_ipk_) :: i
@ -296,15 +296,15 @@ subroutine psi_igthzmm(n,k,idx,x,y)
y(i,1:k)=x(idx(i),1:k) y(i,1:k)=x(idx(i),1:k)
end do end do
end subroutine psi_igthzmm end subroutine psi_mgthzmm
subroutine psi_igthzmv(n,k,idx,x,y) subroutine psi_mgthzmv(n,k,idx,x,y)
use psb_const_mod use psb_const_mod
implicit none implicit none
integer(psb_ipk_) :: n, k, idx(:) integer(psb_ipk_) :: n, k, idx(:)
integer(psb_ipk_) :: x(:,:), y(:) integer(psb_mpk_) :: x(:,:), y(:)
! Locals ! Locals
integer(psb_ipk_) :: i, j, pt integer(psb_ipk_) :: i, j, pt
@ -317,15 +317,15 @@ subroutine psi_igthzmv(n,k,idx,x,y)
end do end do
end do end do
end subroutine psi_igthzmv end subroutine psi_mgthzmv
subroutine psi_igthzv(n,idx,x,y) subroutine psi_mgthzv(n,idx,x,y)
use psb_const_mod use psb_const_mod
implicit none implicit none
integer(psb_ipk_) :: n, idx(:) integer(psb_ipk_) :: n, idx(:)
integer(psb_ipk_) :: x(:), y(:) integer(psb_mpk_) :: x(:), y(:)
! Locals ! Locals
integer(psb_ipk_) :: i integer(psb_ipk_) :: i
@ -334,24 +334,24 @@ subroutine psi_igthzv(n,idx,x,y)
y(i)=x(idx(i)) y(i)=x(idx(i))
end do end do
end subroutine psi_igthzv end subroutine psi_mgthzv
subroutine psi_isctmm(n,k,idx,x,beta,y) subroutine psi_msctmm(n,k,idx,x,beta,y)
use psb_const_mod use psb_const_mod
implicit none implicit none
integer(psb_ipk_) :: n, k, idx(:) integer(psb_ipk_) :: n, k, idx(:)
integer(psb_ipk_) :: beta, x(:,:), y(:,:) integer(psb_mpk_) :: beta, x(:,:), y(:,:)
! Locals ! Locals
integer(psb_ipk_) :: i, j integer(psb_ipk_) :: i, j
if (beta == izero) then if (beta == mzero) then
do i=1,n do i=1,n
y(idx(i),1:k) = x(i,1:k) y(idx(i),1:k) = x(i,1:k)
end do end do
else if (beta == ione) then else if (beta == mone) then
do i=1,n do i=1,n
y(idx(i),1:k) = y(idx(i),1:k)+x(i,1:k) y(idx(i),1:k) = y(idx(i),1:k)+x(i,1:k)
end do end do
@ -360,20 +360,20 @@ subroutine psi_isctmm(n,k,idx,x,beta,y)
y(idx(i),1:k) = beta*y(idx(i),1:k)+x(i,1:k) y(idx(i),1:k) = beta*y(idx(i),1:k)+x(i,1:k)
end do end do
end if end if
end subroutine psi_isctmm end subroutine psi_msctmm
subroutine psi_isctmv(n,k,idx,x,beta,y) subroutine psi_msctmv(n,k,idx,x,beta,y)
use psb_const_mod use psb_const_mod
implicit none implicit none
integer(psb_ipk_) :: n, k, idx(:) integer(psb_ipk_) :: n, k, idx(:)
integer(psb_ipk_) :: beta, x(:), y(:,:) integer(psb_mpk_) :: beta, x(:), y(:,:)
! Locals ! Locals
integer(psb_ipk_) :: i, j, pt integer(psb_ipk_) :: i, j, pt
if (beta == izero) then if (beta == mzero) then
pt=0 pt=0
do j=1,k do j=1,k
do i=1,n do i=1,n
@ -381,7 +381,7 @@ subroutine psi_isctmv(n,k,idx,x,beta,y)
y(idx(i),j) = x(pt) y(idx(i),j) = x(pt)
end do end do
end do end do
else if (beta == ione) then else if (beta == mone) then
pt=0 pt=0
do j=1,k do j=1,k
do i=1,n do i=1,n
@ -398,24 +398,24 @@ subroutine psi_isctmv(n,k,idx,x,beta,y)
end do end do
end do end do
end if end if
end subroutine psi_isctmv end subroutine psi_msctmv
subroutine psi_isctv(n,idx,x,beta,y) subroutine psi_msctv(n,idx,x,beta,y)
use psb_const_mod use psb_const_mod
implicit none implicit none
integer(psb_ipk_) :: n, idx(:) integer(psb_ipk_) :: n, idx(:)
integer(psb_ipk_) :: beta, x(:), y(:) integer(psb_mpk_) :: beta, x(:), y(:)
! Locals ! Locals
integer(psb_ipk_) :: i integer(psb_ipk_) :: i
if (beta == izero) then if (beta == mzero) then
do i=1,n do i=1,n
y(idx(i)) = x(i) y(idx(i)) = x(i)
end do end do
else if (beta == ione) then else if (beta == mone) then
do i=1,n do i=1,n
y(idx(i)) = y(idx(i))+x(i) y(idx(i)) = y(idx(i))+x(i)
end do end do
@ -424,19 +424,19 @@ subroutine psi_isctv(n,idx,x,beta,y)
y(idx(i)) = beta*y(idx(i))+x(i) y(idx(i)) = beta*y(idx(i))+x(i)
end do end do
end if end if
end subroutine psi_isctv end subroutine psi_msctv
subroutine iaxpby(m, n, alpha, X, lldx, beta, Y, lldy, info) subroutine maxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
use psb_const_mod use psb_const_mod
use psb_error_mod use psb_error_mod
implicit none implicit none
integer(psb_ipk_) :: n, m, lldx, lldy, info integer(psb_ipk_) :: n, m, lldx, lldy, info
integer(psb_ipk_) X(lldx,*), Y(lldy,*) integer(psb_mpk_) X(lldx,*), Y(lldy,*)
integer(psb_ipk_) alpha, beta integer(psb_mpk_) alpha, beta
integer(psb_ipk_) :: i, j integer(psb_ipk_) :: i, j
integer(psb_ipk_) :: int_err(5) integer(psb_ipk_) :: int_err(5)
character name*20 character name*20
name='iaxpby' name='maxpby'
! !
@ -473,19 +473,19 @@ subroutine iaxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
goto 9999 goto 9999
endif endif
if (alpha.eq.izero) then if (alpha.eq.mzero) then
if (beta.eq.izero) then if (beta.eq.mzero) then
do j=1, n do j=1, n
do i=1,m do i=1,m
y(i,j) = izero y(i,j) = mzero
enddo enddo
enddo enddo
else if (beta.eq.ione) then else if (beta.eq.mone) then
! !
! Do nothing! ! Do nothing!
! !
else if (beta.eq.-ione) then else if (beta.eq.-mone) then
do j=1,n do j=1,n
do i=1,m do i=1,m
y(i,j) = - y(i,j) y(i,j) = - y(i,j)
@ -499,22 +499,22 @@ subroutine iaxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
enddo enddo
endif endif
else if (alpha.eq.ione) then else if (alpha.eq.mone) then
if (beta.eq.izero) then if (beta.eq.mzero) then
do j=1,n do j=1,n
do i=1,m do i=1,m
y(i,j) = x(i,j) y(i,j) = x(i,j)
enddo enddo
enddo enddo
else if (beta.eq.ione) then else if (beta.eq.mone) then
do j=1,n do j=1,n
do i=1,m do i=1,m
y(i,j) = x(i,j) + y(i,j) y(i,j) = x(i,j) + y(i,j)
enddo enddo
enddo enddo
else if (beta.eq.-ione) then else if (beta.eq.-mone) then
do j=1,n do j=1,n
do i=1,m do i=1,m
y(i,j) = x(i,j) - y(i,j) y(i,j) = x(i,j) - y(i,j)
@ -528,22 +528,22 @@ subroutine iaxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
enddo enddo
endif endif
else if (alpha.eq.-ione) then else if (alpha.eq.-mone) then
if (beta.eq.izero) then if (beta.eq.mzero) then
do j=1,n do j=1,n
do i=1,m do i=1,m
y(i,j) = -x(i,j) y(i,j) = -x(i,j)
enddo enddo
enddo enddo
else if (beta.eq.ione) then else if (beta.eq.mone) then
do j=1,n do j=1,n
do i=1,m do i=1,m
y(i,j) = -x(i,j) + y(i,j) y(i,j) = -x(i,j) + y(i,j)
enddo enddo
enddo enddo
else if (beta.eq.-ione) then else if (beta.eq.-mone) then
do j=1,n do j=1,n
do i=1,m do i=1,m
y(i,j) = -x(i,j) - y(i,j) y(i,j) = -x(i,j) - y(i,j)
@ -559,20 +559,20 @@ subroutine iaxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
else else
if (beta.eq.izero) then if (beta.eq.mzero) then
do j=1,n do j=1,n
do i=1,m do i=1,m
y(i,j) = alpha*x(i,j) y(i,j) = alpha*x(i,j)
enddo enddo
enddo enddo
else if (beta.eq.ione) then else if (beta.eq.mone) then
do j=1,n do j=1,n
do i=1,m do i=1,m
y(i,j) = alpha*x(i,j) + y(i,j) y(i,j) = alpha*x(i,j) + y(i,j)
enddo enddo
enddo enddo
else if (beta.eq.-ione) then else if (beta.eq.-mone) then
do j=1,n do j=1,n
do i=1,m do i=1,m
y(i,j) = alpha*x(i,j) - y(i,j) y(i,j) = alpha*x(i,j) - y(i,j)
@ -594,4 +594,4 @@ subroutine iaxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
call fcpsb_serror() call fcpsb_serror()
return return
end subroutine iaxpby end subroutine maxpby

204
util/psb_partidx_mod.F90
Unescape Escape View File

@ -38,21 +38,25 @@
! See test/pargen/psb_X_pdeNd for examples of usage ! See test/pargen/psb_X_pdeNd for examples of usage
! !
module psb_partidx_mod module psb_partidx_mod
use psb_base_mod, only : psb_ipk_ use psb_base_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_
interface idx2ijk interface idx2ijk
module procedure idx2ijk3d, idx2ijkv, idx2ijk2d,& module procedure idx2ijk3d, idx2ijkv, idx2ijk2d
& lidx2ijk3d, lidx2ijkv, lidx2ijk2d,& end interface idx2ijk
interface ijk2idx
module procedure ijk2idx3d, ijk2idxv, ijk2idx2d
end interface ijk2idx
interface idx2ijk
module procedure lidx2ijk3d, lidx2ijkv, lidx2ijk2d,&
& lidx2lijk3d, lidx2lijkv, lidx2lijk2d & lidx2lijk3d, lidx2lijkv, lidx2lijk2d
end interface idx2ijk end interface idx2ijk
interface ijk2idx interface ijk2idx
module procedure ijk2idx3d, ijk2idxv, ijk2idx2d,& module procedure ijk2lidx3d, ijk2lidxv, ijk2lidx2d,&
& ijk2lidx3d, ijk2lidxv, ijk2lidx2d,&
& lijk2lidx3d, lijk2lidxv, lijk2lidx2d & lijk2lidx3d, lijk2lidxv, lijk2lidx2d
end interface ijk2idx end interface ijk2idx
contains contains
! !
! Given a global index IDX and the domain size (NX,NY,NZ) ! Given a global index IDX and the domain size (NX,NY,NZ)
@ -67,13 +71,13 @@ contains
! ijk2idx(i,j,k) = idx ! ijk2idx(i,j,k) = idx
! idx = idx + 1 ! idx = idx + 1
subroutine idx2ijk3d(i,j,k,idx,nx,ny,nz,base) subroutine idx2ijk3d(i,j,k,idx,nx,ny,nz,base)
use psb_base_mod, only : psb_ipk_ use psb_base_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_
implicit none implicit none
integer(psb_ipk_), intent(out) :: i,j,k integer(psb_mpk_), intent(out) :: i,j,k
integer(psb_ipk_), intent(in) :: idx,nx,ny,nz integer(psb_mpk_), intent(in) :: idx,nx,ny,nz
integer(psb_ipk_), intent(in), optional :: base integer(psb_mpk_), intent(in), optional :: base
integer(psb_ipk_) :: coords(3) integer(psb_mpk_) :: coords(3)
call idx2ijk(coords,idx,[nx,ny,nz],base) call idx2ijk(coords,idx,[nx,ny,nz],base)
@ -84,13 +88,13 @@ contains
end subroutine idx2ijk3d end subroutine idx2ijk3d
subroutine idx2ijk2d(i,j,idx,nx,ny,base) subroutine idx2ijk2d(i,j,idx,nx,ny,base)
use psb_base_mod, only : psb_ipk_ use psb_base_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_
implicit none implicit none
integer(psb_ipk_), intent(out) :: i,j integer(psb_mpk_), intent(out) :: i,j
integer(psb_ipk_), intent(in) :: idx,nx,ny integer(psb_mpk_), intent(in) :: idx,nx,ny
integer(psb_ipk_), intent(in), optional :: base integer(psb_mpk_), intent(in), optional :: base
integer(psb_ipk_) :: coords(2) integer(psb_mpk_) :: coords(2)
call idx2ijk(coords,idx,[nx,ny],base) call idx2ijk(coords,idx,[nx,ny],base)
@ -112,13 +116,13 @@ contains
! ijk2idx(i,j,k) = idx ! ijk2idx(i,j,k) = idx
! idx = idx + 1 ! idx = idx + 1
subroutine idx2ijkv(coords,idx,dims,base) subroutine idx2ijkv(coords,idx,dims,base)
use psb_base_mod, only : psb_ipk_ use psb_base_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_
implicit none implicit none
integer(psb_ipk_), intent(out) :: coords(:) integer(psb_mpk_), intent(out) :: coords(:)
integer(psb_ipk_), intent(in) :: idx,dims(:) integer(psb_mpk_), intent(in) :: idx,dims(:)
integer(psb_ipk_), intent(in), optional :: base integer(psb_mpk_), intent(in), optional :: base
integer(psb_ipk_) :: base_, idx_, i, sz integer(psb_mpk_) :: base_, idx_, i, sz
if (present(base)) then if (present(base)) then
base_ = base base_ = base
else else
@ -147,14 +151,14 @@ contains
end subroutine idx2ijkv end subroutine idx2ijkv
subroutine lidx2ijk3d(i,j,k,idx,nx,ny,nz,base) subroutine lidx2ijk3d(i,j,k,idx,nx,ny,nz,base)
use psb_base_mod, only : psb_ipk_, psb_lpk_ use psb_base_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_
implicit none implicit none
integer(psb_ipk_), intent(out) :: i,j,k integer(psb_mpk_), intent(out) :: i,j,k
integer(psb_lpk_), intent(in) :: idx integer(psb_epk_), intent(in) :: idx
integer(psb_ipk_), intent(in) :: nx,ny,nz integer(psb_mpk_), intent(in) :: nx,ny,nz
integer(psb_ipk_), intent(in), optional :: base integer(psb_mpk_), intent(in), optional :: base
integer(psb_ipk_) :: coords(3) integer(psb_mpk_) :: coords(3)
call idx2ijk(coords,idx,[nx,ny,nz],base) call idx2ijk(coords,idx,[nx,ny,nz],base)
@ -165,14 +169,14 @@ contains
end subroutine lidx2ijk3d end subroutine lidx2ijk3d
subroutine lidx2ijk2d(i,j,idx,nx,ny,base) subroutine lidx2ijk2d(i,j,idx,nx,ny,base)
use psb_base_mod, only : psb_ipk_, psb_lpk_ use psb_base_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_
implicit none implicit none
integer(psb_ipk_), intent(out) :: i,j integer(psb_mpk_), intent(out) :: i,j
integer(psb_lpk_), intent(in) :: idx integer(psb_epk_), intent(in) :: idx
integer(psb_ipk_), intent(in) :: nx,ny integer(psb_mpk_), intent(in) :: nx,ny
integer(psb_ipk_), intent(in), optional :: base integer(psb_mpk_), intent(in), optional :: base
integer(psb_ipk_) :: coords(2) integer(psb_mpk_) :: coords(2)
call idx2ijk(coords,idx,[nx,ny],base) call idx2ijk(coords,idx,[nx,ny],base)
@ -194,15 +198,15 @@ contains
! ijk2idx(i,j,k) = idx ! ijk2idx(i,j,k) = idx
! idx = idx + 1 ! idx = idx + 1
subroutine lidx2ijkv(coords,idx,dims,base) subroutine lidx2ijkv(coords,idx,dims,base)
use psb_base_mod, only : psb_ipk_, psb_lpk_ use psb_base_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_
implicit none implicit none
integer(psb_ipk_), intent(out) :: coords(:) integer(psb_mpk_), intent(out) :: coords(:)
integer(psb_lpk_), intent(in) :: idx integer(psb_epk_), intent(in) :: idx
integer(psb_ipk_), intent(in) :: dims(:) integer(psb_mpk_), intent(in) :: dims(:)
integer(psb_ipk_), intent(in), optional :: base integer(psb_mpk_), intent(in), optional :: base
integer(psb_lpk_) :: base_, idx_ integer(psb_epk_) :: base_, idx_
integer(psb_ipk_) :: i, sz integer(psb_mpk_) :: i, sz
if (present(base)) then if (present(base)) then
base_ = base base_ = base
else else
@ -231,14 +235,14 @@ contains
end subroutine lidx2ijkv end subroutine lidx2ijkv
subroutine lidx2lijk3d(i,j,k,idx,nx,ny,nz,base) subroutine lidx2lijk3d(i,j,k,idx,nx,ny,nz,base)
use psb_base_mod, only : psb_ipk_, psb_lpk_ use psb_base_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_
implicit none implicit none
integer(psb_lpk_), intent(out) :: i,j,k integer(psb_epk_), intent(out) :: i,j,k
integer(psb_lpk_), intent(in) :: idx integer(psb_epk_), intent(in) :: idx
integer(psb_lpk_), intent(in) :: nx,ny,nz integer(psb_epk_), intent(in) :: nx,ny,nz
integer(psb_ipk_), intent(in), optional :: base integer(psb_mpk_), intent(in), optional :: base
integer(psb_lpk_) :: coords(3) integer(psb_epk_) :: coords(3)
call idx2ijk(coords,idx,[nx,ny,nz],base) call idx2ijk(coords,idx,[nx,ny,nz],base)
@ -249,14 +253,14 @@ contains
end subroutine lidx2lijk3d end subroutine lidx2lijk3d
subroutine lidx2lijk2d(i,j,idx,nx,ny,base) subroutine lidx2lijk2d(i,j,idx,nx,ny,base)
use psb_base_mod, only : psb_ipk_, psb_lpk_ use psb_base_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_
implicit none implicit none
integer(psb_lpk_), intent(out) :: i,j integer(psb_epk_), intent(out) :: i,j
integer(psb_lpk_), intent(in) :: idx integer(psb_epk_), intent(in) :: idx
integer(psb_lpk_), intent(in) :: nx,ny integer(psb_epk_), intent(in) :: nx,ny
integer(psb_ipk_), intent(in), optional :: base integer(psb_mpk_), intent(in), optional :: base
integer(psb_lpk_) :: coords(2) integer(psb_epk_) :: coords(2)
call idx2ijk(coords,idx,[nx,ny],base) call idx2ijk(coords,idx,[nx,ny],base)
@ -278,15 +282,15 @@ contains
! ijk2idx(i,j,k) = idx ! ijk2idx(i,j,k) = idx
! idx = idx + 1 ! idx = idx + 1
subroutine lidx2lijkv(coords,idx,dims,base) subroutine lidx2lijkv(coords,idx,dims,base)
use psb_base_mod, only : psb_ipk_, psb_lpk_ use psb_base_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_
implicit none implicit none
integer(psb_lpk_), intent(out) :: coords(:) integer(psb_epk_), intent(out) :: coords(:)
integer(psb_lpk_), intent(in) :: idx integer(psb_epk_), intent(in) :: idx
integer(psb_lpk_), intent(in) :: dims(:) integer(psb_epk_), intent(in) :: dims(:)
integer(psb_ipk_), intent(in), optional :: base integer(psb_mpk_), intent(in), optional :: base
integer(psb_lpk_) :: base_, idx_ integer(psb_epk_) :: base_, idx_
integer(psb_lpk_) :: i, sz integer(psb_epk_) :: i, sz
if (present(base)) then if (present(base)) then
base_ = base base_ = base
else else
@ -313,7 +317,6 @@ contains
end do end do
end subroutine lidx2lijkv end subroutine lidx2lijkv
! !
! Given a triple (I,J,K) and the domain size (NX,NY,NZ) ! Given a triple (I,J,K) and the domain size (NX,NY,NZ)
! compute the global index IDX ! compute the global index IDX
@ -327,13 +330,13 @@ contains
! ijk2idx(i,j,k) = idx ! ijk2idx(i,j,k) = idx
! idx = idx + 1 ! idx = idx + 1
subroutine ijk2idxv(idx,coords,dims,base) subroutine ijk2idxv(idx,coords,dims,base)
use psb_base_mod, only : psb_ipk_ use psb_base_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_
implicit none implicit none
integer(psb_ipk_), intent(in) :: coords(:),dims(:) integer(psb_mpk_), intent(in) :: coords(:),dims(:)
integer(psb_ipk_), intent(out) :: idx integer(psb_mpk_), intent(out) :: idx
integer(psb_ipk_), intent(in), optional :: base integer(psb_mpk_), intent(in), optional :: base
integer(psb_ipk_) :: base_, i, sz integer(psb_mpk_) :: base_, i, sz
if (present(base)) then if (present(base)) then
base_ = base base_ = base
else else
@ -366,35 +369,35 @@ contains
! ijk2idx(i,j,k) = idx ! ijk2idx(i,j,k) = idx
! idx = idx + 1 ! idx = idx + 1
subroutine ijk2idx3d(idx,i,j,k,nx,ny,nz,base) subroutine ijk2idx3d(idx,i,j,k,nx,ny,nz,base)
use psb_base_mod, only : psb_ipk_ use psb_base_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_
implicit none implicit none
integer(psb_ipk_), intent(out) :: idx integer(psb_mpk_), intent(out) :: idx
integer(psb_ipk_), intent(in) :: i,j,k,nx,ny,nz integer(psb_mpk_), intent(in) :: i,j,k,nx,ny,nz
integer(psb_ipk_), intent(in), optional :: base integer(psb_mpk_), intent(in), optional :: base
! idx = ((i-base_)*nz*ny + (j-base_)*nz + k - base_) + base_ ! idx = ((i-base_)*nz*ny + (j-base_)*nz + k - base_) + base_
call ijk2idx(idx,[i,j,k],[nx,ny,nz],base) call ijk2idx(idx,[i,j,k],[nx,ny,nz],base)
end subroutine ijk2idx3d end subroutine ijk2idx3d
subroutine ijk2idx2d(idx,i,j,nx,ny,base) subroutine ijk2idx2d(idx,i,j,nx,ny,base)
use psb_base_mod, only : psb_ipk_ use psb_base_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_
implicit none implicit none
integer(psb_ipk_), intent(out) :: idx integer(psb_mpk_), intent(out) :: idx
integer(psb_ipk_), intent(in) :: i,j,nx,ny integer(psb_mpk_), intent(in) :: i,j,nx,ny
integer(psb_ipk_), intent(in), optional :: base integer(psb_mpk_), intent(in), optional :: base
! idx = ((i-base_)*ny + (j-base_) + base_ ! idx = ((i-base_)*ny + (j-base_) + base_
call ijk2idx(idx,[i,j],[nx,ny],base) call ijk2idx(idx,[i,j],[nx,ny],base)
end subroutine ijk2idx2d end subroutine ijk2idx2d
subroutine ijk2lidxv(idx,coords,dims,base) subroutine ijk2lidxv(idx,coords,dims,base)
use psb_base_mod, only : psb_ipk_, psb_lpk_ use psb_base_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_
implicit none implicit none
integer(psb_ipk_), intent(in) :: coords(:),dims(:) integer(psb_mpk_), intent(in) :: coords(:),dims(:)
integer(psb_lpk_), intent(out) :: idx integer(psb_epk_), intent(out) :: idx
integer(psb_ipk_), intent(in), optional :: base integer(psb_mpk_), intent(in), optional :: base
integer(psb_ipk_) :: base_, i, sz integer(psb_mpk_) :: base_, i, sz
if (present(base)) then if (present(base)) then
base_ = base base_ = base
else else
@ -427,22 +430,22 @@ contains
! ijk2idx(i,j,k) = idx ! ijk2idx(i,j,k) = idx
! idx = idx + 1 ! idx = idx + 1
subroutine ijk2lidx3d(idx,i,j,k,nx,ny,nz,base) subroutine ijk2lidx3d(idx,i,j,k,nx,ny,nz,base)
use psb_base_mod, only : psb_ipk_, psb_lpk_ use psb_base_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_
implicit none implicit none
integer(psb_lpk_), intent(out) :: idx integer(psb_epk_), intent(out) :: idx
integer(psb_ipk_), intent(in) :: i,j,k,nx,ny,nz integer(psb_mpk_), intent(in) :: i,j,k,nx,ny,nz
integer(psb_ipk_), intent(in), optional :: base integer(psb_mpk_), intent(in), optional :: base
! idx = ((i-base_)*nz*ny + (j-base_)*nz + k - base_) + base_ ! idx = ((i-base_)*nz*ny + (j-base_)*nz + k - base_) + base_
call ijk2idx(idx,[i,j,k],[nx,ny,nz],base) call ijk2idx(idx,[i,j,k],[nx,ny,nz],base)
end subroutine ijk2lidx3d end subroutine ijk2lidx3d
subroutine ijk2lidx2d(idx,i,j,nx,ny,base) subroutine ijk2lidx2d(idx,i,j,nx,ny,base)
use psb_base_mod, only : psb_ipk_, psb_lpk_ use psb_base_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_
implicit none implicit none
integer(psb_lpk_), intent(out) :: idx integer(psb_epk_), intent(out) :: idx
integer(psb_ipk_), intent(in) :: i,j,nx,ny integer(psb_mpk_), intent(in) :: i,j,nx,ny
integer(psb_ipk_), intent(in), optional :: base integer(psb_mpk_), intent(in), optional :: base
! idx = ((i-base_)*ny + (j-base_) + base_ ! idx = ((i-base_)*ny + (j-base_) + base_
call ijk2idx(idx,[i,j],[nx,ny],base) call ijk2idx(idx,[i,j],[nx,ny],base)
@ -450,13 +453,13 @@ contains
subroutine lijk2lidxv(idx,coords,dims,base) subroutine lijk2lidxv(idx,coords,dims,base)
use psb_base_mod, only : psb_ipk_, psb_lpk_ use psb_base_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_
implicit none implicit none
integer(psb_lpk_), intent(in) :: coords(:),dims(:) integer(psb_epk_), intent(in) :: coords(:),dims(:)
integer(psb_lpk_), intent(out) :: idx integer(psb_epk_), intent(out) :: idx
integer(psb_ipk_), intent(in), optional :: base integer(psb_mpk_), intent(in), optional :: base
integer(psb_lpk_) :: base_, i, sz integer(psb_epk_) :: base_, i, sz
if (present(base)) then if (present(base)) then
base_ = base base_ = base
else else
@ -489,28 +492,27 @@ contains
! ijk2idx(i,j,k) = idx ! ijk2idx(i,j,k) = idx
! idx = idx + 1 ! idx = idx + 1
subroutine lijk2lidx3d(idx,i,j,k,nx,ny,nz,base) subroutine lijk2lidx3d(idx,i,j,k,nx,ny,nz,base)
use psb_base_mod, only : psb_ipk_, psb_lpk_ use psb_base_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_
implicit none implicit none
integer(psb_lpk_), intent(out) :: idx integer(psb_epk_), intent(out) :: idx
integer(psb_lpk_), intent(in) :: i,j,k,nx,ny,nz integer(psb_epk_), intent(in) :: i,j,k,nx,ny,nz
integer(psb_ipk_), intent(in), optional :: base integer(psb_mpk_), intent(in), optional :: base
! idx = ((i-base_)*nz*ny + (j-base_)*nz + k - base_) + base_ ! idx = ((i-base_)*nz*ny + (j-base_)*nz + k - base_) + base_
call ijk2idx(idx,[i,j,k],[nx,ny,nz],base) call ijk2idx(idx,[i,j,k],[nx,ny,nz],base)
end subroutine lijk2lidx3d end subroutine lijk2lidx3d
subroutine lijk2lidx2d(idx,i,j,nx,ny,base) subroutine lijk2lidx2d(idx,i,j,nx,ny,base)
use psb_base_mod, only : psb_ipk_, psb_lpk_ use psb_base_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_
implicit none implicit none
integer(psb_lpk_), intent(out) :: idx integer(psb_epk_), intent(out) :: idx
integer(psb_lpk_), intent(in) :: i,j,nx,ny integer(psb_epk_), intent(in) :: i,j,nx,ny
integer(psb_ipk_), intent(in), optional :: base integer(psb_mpk_), intent(in), optional :: base
! idx = ((i-base_)*ny + (j-base_) + base_ ! idx = ((i-base_)*ny + (j-base_) + base_
call ijk2idx(idx,[i,j],[nx,ny],base) call ijk2idx(idx,[i,j],[nx,ny],base)
end subroutine lijk2lidx2d end subroutine lijk2lidx2d
! !
! dist1Didx ! dist1Didx
! Given an index space [base : N-(1-base)] and ! Given an index space [base : N-(1-base)] and
@ -523,7 +525,7 @@ contains
! V(P+1) : first index owned by process P+1 ! V(P+1) : first index owned by process P+1
! !
subroutine dist1Didx(v,n,np,base) subroutine dist1Didx(v,n,np,base)
use psb_base_mod, only : psb_ipk_ use psb_base_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_
implicit none implicit none
integer(psb_ipk_), intent(out) :: v(:) integer(psb_ipk_), intent(out) :: v(:)
integer(psb_ipk_), intent(in) :: n, np integer(psb_ipk_), intent(in) :: n, np

Write Preview
Loading…
Cancel
Save