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_d_psblas_mod.o psblas/psb_z_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_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\
@ -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_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_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_s_ip_reord_mod.o auxil/psb_d_ip_reord_mod.o \

31
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
interface psb_hash_init
module procedure psb_hash_init_v, psb_hash_init_n, &
& psb_hash_init_lv, psb_hash_init_ln
end interface
module procedure psb_hash_init_lv, psb_hash_init_ln
end interface psb_hash_init
interface psb_sizeof
module procedure psb_sizeof_hash_type
end interface
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
interface psb_hash_searchinskey
module procedure psb_hash_searchinskey, psb_hash_lsearchinskey
module procedure psb_hash_searchinskey
end interface psb_hash_searchinskey
interface psb_hash_searchkey
module procedure psb_hash_searchkey, psb_hash_lsearchkey
module procedure psb_hash_searchkey
end interface psb_hash_searchkey
#endif
interface psb_move_alloc
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
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
! 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
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
! 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.
!
!
module psi_i_serial_mod
use psb_const_mod, only : psb_ipk_, psb_lpk_
module psi_e_serial_mod
use psb_const_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_
interface psb_gelp
! 2-D version
subroutine psb_igelp(trans,iperm,x,info)
import :: psb_ipk_, psb_lpk_
subroutine psb_egelp(trans,iperm,x,info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_), intent(inout) :: x(:,:)
integer(psb_epk_), intent(inout) :: x(:,:)
integer(psb_ipk_), intent(in) :: iperm(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in) :: trans
end subroutine psb_igelp
subroutine psb_igelpv(trans,iperm,x,info)
import :: psb_ipk_, psb_lpk_
end subroutine psb_egelp
subroutine psb_egelpv(trans,iperm,x,info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_epk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: iperm(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in) :: trans
end subroutine psb_igelpv
end subroutine psb_egelpv
end interface psb_gelp
interface psb_geaxpby
subroutine psi_iaxpby(m,n,alpha, x, beta, y, info)
import :: psb_ipk_, psb_lpk_
subroutine psi_eaxpby(m,n,alpha, x, beta, y, info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_), intent(in) :: m, n
integer(psb_ipk_), intent (in) :: x(:,:)
integer(psb_ipk_), intent (inout) :: y(:,:)
integer(psb_ipk_), intent (in) :: alpha, beta
integer(psb_epk_), intent (in) :: x(:,:)
integer(psb_epk_), intent (inout) :: y(:,:)
integer(psb_epk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info
end subroutine psi_iaxpby
subroutine psi_iaxpbyv(m,alpha, x, beta, y, info)
import :: psb_ipk_, psb_lpk_
end subroutine psi_eaxpby
subroutine psi_eaxpbyv(m,alpha, x, beta, y, info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_), intent(in) :: m
integer(psb_ipk_), intent (in) :: x(:)
integer(psb_ipk_), intent (inout) :: y(:)
integer(psb_ipk_), intent (in) :: alpha, beta
integer(psb_epk_), intent (in) :: x(:)
integer(psb_epk_), intent (inout) :: y(:)
integer(psb_epk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info
end subroutine psi_iaxpbyv
end subroutine psi_eaxpbyv
end interface psb_geaxpby
interface psi_gth
subroutine psi_igthmv(n,k,idx,alpha,x,beta,y)
import :: psb_ipk_, psb_lpk_
subroutine psi_egthmv(n,k,idx,alpha,x,beta,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_ipk_) :: x(:,:), y(:),alpha,beta
end subroutine psi_igthmv
subroutine psi_igthv(n,idx,alpha,x,beta,y)
import :: psb_ipk_, psb_lpk_
integer(psb_epk_) :: x(:,:), y(:),alpha,beta
end subroutine psi_egthmv
subroutine psi_egthv(n,idx,alpha,x,beta,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, idx(:)
integer(psb_ipk_) :: x(:), y(:),alpha,beta
end subroutine psi_igthv
subroutine psi_igthzmv(n,k,idx,x,y)
import :: psb_ipk_, psb_lpk_
integer(psb_epk_) :: x(:), y(:),alpha,beta
end subroutine psi_egthv
subroutine psi_egthzmv(n,k,idx,x,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_ipk_) :: x(:,:), y(:)
integer(psb_epk_) :: x(:,:), y(:)
end subroutine psi_igthzmv
subroutine psi_igthzmm(n,k,idx,x,y)
import :: psb_ipk_, psb_lpk_
end subroutine psi_egthzmv
subroutine psi_egthzmm(n,k,idx,x,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_ipk_) :: x(:,:), y(:,:)
integer(psb_epk_) :: x(:,:), y(:,:)
end subroutine psi_igthzmm
subroutine psi_igthzv(n,idx,x,y)
import :: psb_ipk_, psb_lpk_
end subroutine psi_egthzmm
subroutine psi_egthzv(n,idx,x,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, idx(:)
integer(psb_ipk_) :: x(:), y(:)
end subroutine psi_igthzv
integer(psb_epk_) :: x(:), y(:)
end subroutine psi_egthzv
end interface psi_gth
interface psi_sct
subroutine psi_isctmm(n,k,idx,x,beta,y)
import :: psb_ipk_, psb_lpk_
subroutine psi_esctmm(n,k,idx,x,beta,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_ipk_) :: beta, x(:,:), y(:,:)
end subroutine psi_isctmm
subroutine psi_isctmv(n,k,idx,x,beta,y)
import :: psb_ipk_, psb_lpk_
integer(psb_epk_) :: beta, x(:,:), y(:,:)
end subroutine psi_esctmm
subroutine psi_esctmv(n,k,idx,x,beta,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_ipk_) :: beta, x(:), y(:,:)
end subroutine psi_isctmv
subroutine psi_isctv(n,idx,x,beta,y)
import :: psb_ipk_, psb_lpk_
integer(psb_epk_) :: beta, x(:), y(:,:)
end subroutine psi_esctmv
subroutine psi_esctv(n,idx,x,beta,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, idx(:)
integer(psb_ipk_) :: beta, x(:), y(:)
end subroutine psi_isctv
integer(psb_epk_) :: beta, x(:), y(:)
end subroutine psi_esctv
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.
!
!
module psi_l_serial_mod
use psb_const_mod, only : psb_ipk_, psb_lpk_
module psi_m_serial_mod
use psb_const_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_
interface psb_gelp
! 2-D version
subroutine psb_lgelp(trans,iperm,x,info)
import :: psb_ipk_, psb_lpk_
subroutine psb_mgelp(trans,iperm,x,info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_lpk_), intent(inout) :: x(:,:)
integer(psb_mpk_), intent(inout) :: x(:,:)
integer(psb_ipk_), intent(in) :: iperm(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in) :: trans
end subroutine psb_lgelp
subroutine psb_lgelpv(trans,iperm,x,info)
import :: psb_ipk_, psb_lpk_
end subroutine psb_mgelp
subroutine psb_mgelpv(trans,iperm,x,info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_lpk_), intent(inout) :: x(:)
integer(psb_mpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: iperm(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in) :: trans
end subroutine psb_lgelpv
end subroutine psb_mgelpv
end interface psb_gelp
interface psb_geaxpby
subroutine psi_laxpby(m,n,alpha, x, beta, y, info)
import :: psb_ipk_, psb_lpk_
subroutine psi_maxpby(m,n,alpha, x, beta, y, info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_), intent(in) :: m, n
integer(psb_lpk_), intent (in) :: x(:,:)
integer(psb_lpk_), intent (inout) :: y(:,:)
integer(psb_lpk_), intent (in) :: alpha, beta
integer(psb_mpk_), intent (in) :: x(:,:)
integer(psb_mpk_), intent (inout) :: y(:,:)
integer(psb_mpk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info
end subroutine psi_laxpby
subroutine psi_laxpbyv(m,alpha, x, beta, y, info)
import :: psb_ipk_, psb_lpk_
end subroutine psi_maxpby
subroutine psi_maxpbyv(m,alpha, x, beta, y, info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_), intent(in) :: m
integer(psb_lpk_), intent (in) :: x(:)
integer(psb_lpk_), intent (inout) :: y(:)
integer(psb_lpk_), intent (in) :: alpha, beta
integer(psb_mpk_), intent (in) :: x(:)
integer(psb_mpk_), intent (inout) :: y(:)
integer(psb_mpk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info
end subroutine psi_laxpbyv
end subroutine psi_maxpbyv
end interface psb_geaxpby
interface psi_gth
subroutine psi_lgthmv(n,k,idx,alpha,x,beta,y)
import :: psb_ipk_, psb_lpk_
subroutine psi_mgthmv(n,k,idx,alpha,x,beta,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_lpk_) :: x(:,:), y(:),alpha,beta
end subroutine psi_lgthmv
subroutine psi_lgthv(n,idx,alpha,x,beta,y)
import :: psb_ipk_, psb_lpk_
integer(psb_mpk_) :: x(:,:), y(:),alpha,beta
end subroutine psi_mgthmv
subroutine psi_mgthv(n,idx,alpha,x,beta,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, idx(:)
integer(psb_lpk_) :: x(:), y(:),alpha,beta
end subroutine psi_lgthv
subroutine psi_lgthzmv(n,k,idx,x,y)
import :: psb_ipk_, psb_lpk_
integer(psb_mpk_) :: x(:), y(:),alpha,beta
end subroutine psi_mgthv
subroutine psi_mgthzmv(n,k,idx,x,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_lpk_) :: x(:,:), y(:)
integer(psb_mpk_) :: x(:,:), y(:)
end subroutine psi_lgthzmv
subroutine psi_lgthzmm(n,k,idx,x,y)
import :: psb_ipk_, psb_lpk_
end subroutine psi_mgthzmv
subroutine psi_mgthzmm(n,k,idx,x,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_lpk_) :: x(:,:), y(:,:)
integer(psb_mpk_) :: x(:,:), y(:,:)
end subroutine psi_lgthzmm
subroutine psi_lgthzv(n,idx,x,y)
import :: psb_ipk_, psb_lpk_
end subroutine psi_mgthzmm
subroutine psi_mgthzv(n,idx,x,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, idx(:)
integer(psb_lpk_) :: x(:), y(:)
end subroutine psi_lgthzv
integer(psb_mpk_) :: x(:), y(:)
end subroutine psi_mgthzv
end interface psi_gth
interface psi_sct
subroutine psi_lsctmm(n,k,idx,x,beta,y)
import :: psb_ipk_, psb_lpk_
subroutine psi_msctmm(n,k,idx,x,beta,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_lpk_) :: beta, x(:,:), y(:,:)
end subroutine psi_lsctmm
subroutine psi_lsctmv(n,k,idx,x,beta,y)
import :: psb_ipk_, psb_lpk_
integer(psb_mpk_) :: beta, x(:,:), y(:,:)
end subroutine psi_msctmm
subroutine psi_msctmv(n,k,idx,x,beta,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_lpk_) :: beta, x(:), y(:,:)
end subroutine psi_lsctmv
subroutine psi_lsctv(n,idx,x,beta,y)
import :: psb_ipk_, psb_lpk_
integer(psb_mpk_) :: beta, x(:), y(:,:)
end subroutine psi_msctmv
subroutine psi_msctv(n,idx,x,beta,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
integer(psb_ipk_) :: n, idx(:)
integer(psb_lpk_) :: beta, x(:), y(:)
end subroutine psi_lsctv
integer(psb_mpk_) :: beta, x(:), y(:)
end subroutine psi_msctv
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
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
! 2-D version

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

@ -30,8 +30,8 @@
!
!
module psi_serial_mod
use psi_i_serial_mod
use psi_l_serial_mod
use psi_m_serial_mod
use psi_e_serial_mod
use psi_s_serial_mod
use psi_d_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
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
! 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
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
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_lc => base_get_lc
procedure, pass(idxmap) :: set_gri => base_set_gri
procedure, pass(idxmap) :: set_gci => base_set_gci
procedure, pass(idxmap) :: set_grl => base_set_grl
procedure, pass(idxmap) :: set_gcl => base_set_gcl
generic, public :: set_gr => set_gri, set_grl
generic, public :: set_gc => set_gci, set_gcl
generic, public :: set_gr => set_grl
generic, public :: set_gc => set_gcl
procedure, pass(idxmap) :: set_lr => base_set_lr
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_get_gr, base_get_gc, base_get_lr, base_get_lc, base_get_ctxt,&
& 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_mpic, base_get_fmt, base_asb, base_free,&
& base_l2gs1, base_l2gs2, base_l2gv1, base_l2gv2,&

2
base/serial/Makefile
Unescape Escape View File

@ -1,7 +1,7 @@
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_c_serial_impl.o psi_z_serial_impl.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.
!
!
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_error_mod
implicit none
integer(psb_ipk_), intent(in) :: m, n
integer(psb_lpk_), intent (in) :: x(:,:)
integer(psb_lpk_), intent (inout) :: y(:,:)
integer(psb_lpk_), intent (in) :: alpha, beta
integer(psb_epk_), intent (in) :: x(:,:)
integer(psb_epk_), intent (inout) :: y(:,:)
integer(psb_epk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: lx, ly
@ -76,7 +76,7 @@ subroutine psi_laxpby(m,n,alpha, x, beta, y, info)
goto 9999
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)
return
@ -84,17 +84,17 @@ subroutine psi_laxpby(m,n,alpha, x, beta, y, info)
9999 call psb_error_handler(err_act)
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_error_mod
implicit none
integer(psb_ipk_), intent(in) :: m
integer(psb_lpk_), intent (in) :: x(:)
integer(psb_lpk_), intent (inout) :: y(:)
integer(psb_lpk_), intent (in) :: alpha, beta
integer(psb_epk_), intent (in) :: x(:)
integer(psb_epk_), intent (inout) :: y(:)
integer(psb_epk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: lx, ly
@ -127,7 +127,7 @@ subroutine psi_laxpbyv(m,alpha, x, beta, y, info)
goto 9999
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)
return
@ -136,30 +136,30 @@ subroutine psi_laxpbyv(m,alpha, x, beta, y, info)
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
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_lpk_) :: x(:,:), y(:),alpha,beta
integer(psb_epk_) :: x(:,:), y(:),alpha,beta
! Locals
integer(psb_ipk_) :: i, j, pt
if (beta == lzero) then
if (alpha == lzero) then
if (beta == ezero) then
if (alpha == ezero) then
pt=0
do j=1,k
do i=1,n
pt=pt+1
y(pt) = lzero
y(pt) = ezero
end do
end do
else if (alpha == lone) then
else if (alpha == eone) then
pt=0
do j=1,k
do i=1,n
@ -167,7 +167,7 @@ subroutine psi_lgthmv(n,k,idx,alpha,x,beta,y)
y(pt) = x(idx(i),j)
end do
end do
else if (alpha == -lone) then
else if (alpha == -eone) then
pt=0
do j=1,k
do i=1,n
@ -185,17 +185,17 @@ subroutine psi_lgthmv(n,k,idx,alpha,x,beta,y)
end do
end if
else
if (beta == lone) then
if (beta == eone) then
! Do nothing
else if (beta == -lone) then
else if (beta == -eone) then
y(1:n*k) = -y(1:n*k)
else
y(1:n*k) = beta*y(1:n*k)
end if
if (alpha == lzero) then
if (alpha == ezero) then
! do nothing
else if (alpha == lone) then
else if (alpha == eone) then
pt=0
do j=1,k
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)
end do
end do
else if (alpha == -lone) then
else if (alpha == -eone) then
pt=0
do j=1,k
do i=1,n
@ -222,28 +222,28 @@ subroutine psi_lgthmv(n,k,idx,alpha,x,beta,y)
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
implicit none
integer(psb_ipk_) :: n, idx(:)
integer(psb_lpk_) :: x(:), y(:),alpha,beta
integer(psb_epk_) :: x(:), y(:),alpha,beta
! Locals
integer(psb_ipk_) :: i
if (beta == lzero) then
if (alpha == lzero) then
if (beta == ezero) then
if (alpha == ezero) then
do i=1,n
y(i) = lzero
y(i) = ezero
end do
else if (alpha == lone) then
else if (alpha == eone) then
do i=1,n
y(i) = x(idx(i))
end do
else if (alpha == -lone) then
else if (alpha == -eone) then
do i=1,n
y(i) = -x(idx(i))
end do
@ -253,21 +253,21 @@ subroutine psi_lgthv(n,idx,alpha,x,beta,y)
end do
end if
else
if (beta == lone) then
if (beta == eone) then
! Do nothing
else if (beta == -lone) then
else if (beta == -eone) then
y(1:n) = -y(1:n)
else
y(1:n) = beta*y(1:n)
end if
if (alpha == lzero) then
if (alpha == ezero) then
! do nothing
else if (alpha == lone) then
else if (alpha == eone) then
do i=1,n
y(i) = y(i) + x(idx(i))
end do
else if (alpha == -lone) then
else if (alpha == -eone) then
do i=1,n
y(i) = y(i) - x(idx(i))
end do
@ -278,15 +278,15 @@ subroutine psi_lgthv(n,idx,alpha,x,beta,y)
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
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_lpk_) :: x(:,:), y(:,:)
integer(psb_epk_) :: x(:,:), y(:,:)
! Locals
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)
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
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_lpk_) :: x(:,:), y(:)
integer(psb_epk_) :: x(:,:), y(:)
! Locals
integer(psb_ipk_) :: i, j, pt
@ -317,15 +317,15 @@ subroutine psi_lgthzmv(n,k,idx,x,y)
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
implicit none
integer(psb_ipk_) :: n, idx(:)
integer(psb_lpk_) :: x(:), y(:)
integer(psb_epk_) :: x(:), y(:)
! Locals
integer(psb_ipk_) :: i
@ -334,24 +334,24 @@ subroutine psi_lgthzv(n,idx,x,y)
y(i)=x(idx(i))
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
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_lpk_) :: beta, x(:,:), y(:,:)
integer(psb_epk_) :: beta, x(:,:), y(:,:)
! Locals
integer(psb_ipk_) :: i, j
if (beta == lzero) then
if (beta == ezero) then
do i=1,n
y(idx(i),1:k) = x(i,1:k)
end do
else if (beta == lone) then
else if (beta == eone) then
do i=1,n
y(idx(i),1:k) = y(idx(i),1:k)+x(i,1:k)
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)
end do
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
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_lpk_) :: beta, x(:), y(:,:)
integer(psb_epk_) :: beta, x(:), y(:,:)
! Locals
integer(psb_ipk_) :: i, j, pt
if (beta == lzero) then
if (beta == ezero) then
pt=0
do j=1,k
do i=1,n
@ -381,7 +381,7 @@ subroutine psi_lsctmv(n,k,idx,x,beta,y)
y(idx(i),j) = x(pt)
end do
end do
else if (beta == lone) then
else if (beta == eone) then
pt=0
do j=1,k
do i=1,n
@ -398,24 +398,24 @@ subroutine psi_lsctmv(n,k,idx,x,beta,y)
end do
end do
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
implicit none
integer(psb_ipk_) :: n, idx(:)
integer(psb_lpk_) :: beta, x(:), y(:)
integer(psb_epk_) :: beta, x(:), y(:)
! Locals
integer(psb_ipk_) :: i
if (beta == lzero) then
if (beta == ezero) then
do i=1,n
y(idx(i)) = x(i)
end do
else if (beta == lone) then
else if (beta == eone) then
do i=1,n
y(idx(i)) = y(idx(i))+x(i)
end do
@ -424,19 +424,19 @@ subroutine psi_lsctv(n,idx,x,beta,y)
y(idx(i)) = beta*y(idx(i))+x(i)
end do
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_error_mod
implicit none
integer(psb_ipk_) :: n, m, lldx, lldy, info
integer(psb_lpk_) X(lldx,*), Y(lldy,*)
integer(psb_lpk_) alpha, beta
integer(psb_epk_) X(lldx,*), Y(lldy,*)
integer(psb_epk_) alpha, beta
integer(psb_ipk_) :: i, j
integer(psb_ipk_) :: int_err(5)
character name*20
name='laxpby'
name='eaxpby'
!
@ -473,19 +473,19 @@ subroutine laxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
goto 9999
endif
if (alpha.eq.lzero) then
if (beta.eq.lzero) then
if (alpha.eq.ezero) then
if (beta.eq.ezero) then
do j=1, n
do i=1,m
y(i,j) = lzero
y(i,j) = ezero
enddo
enddo
else if (beta.eq.lone) then
else if (beta.eq.eone) then
!
! Do nothing!
!
else if (beta.eq.-lone) then
else if (beta.eq.-eone) then
do j=1,n
do i=1,m
y(i,j) = - y(i,j)
@ -499,22 +499,22 @@ subroutine laxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
enddo
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 i=1,m
y(i,j) = x(i,j)
enddo
enddo
else if (beta.eq.lone) then
else if (beta.eq.eone) then
do j=1,n
do i=1,m
y(i,j) = x(i,j) + y(i,j)
enddo
enddo
else if (beta.eq.-lone) then
else if (beta.eq.-eone) then
do j=1,n
do i=1,m
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
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 i=1,m
y(i,j) = -x(i,j)
enddo
enddo
else if (beta.eq.lone) then
else if (beta.eq.eone) then
do j=1,n
do i=1,m
y(i,j) = -x(i,j) + y(i,j)
enddo
enddo
else if (beta.eq.-lone) then
else if (beta.eq.-eone) then
do j=1,n
do i=1,m
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
if (beta.eq.lzero) then
if (beta.eq.ezero) then
do j=1,n
do i=1,m
y(i,j) = alpha*x(i,j)
enddo
enddo
else if (beta.eq.lone) then
else if (beta.eq.eone) then
do j=1,n
do i=1,m
y(i,j) = alpha*x(i,j) + y(i,j)
enddo
enddo
else if (beta.eq.-lone) then
else if (beta.eq.-eone) then
do j=1,n
do i=1,m
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()
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.
!
!
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_error_mod
implicit none
integer(psb_ipk_), intent(in) :: m, n
integer(psb_ipk_), intent (in) :: x(:,:)
integer(psb_ipk_), intent (inout) :: y(:,:)
integer(psb_ipk_), intent (in) :: alpha, beta
integer(psb_mpk_), intent (in) :: x(:,:)
integer(psb_mpk_), intent (inout) :: y(:,:)
integer(psb_mpk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: lx, ly
@ -76,7 +76,7 @@ subroutine psi_iaxpby(m,n,alpha, x, beta, y, info)
goto 9999
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)
return
@ -84,17 +84,17 @@ subroutine psi_iaxpby(m,n,alpha, x, beta, y, info)
9999 call psb_error_handler(err_act)
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_error_mod
implicit none
integer(psb_ipk_), intent(in) :: m
integer(psb_ipk_), intent (in) :: x(:)
integer(psb_ipk_), intent (inout) :: y(:)
integer(psb_ipk_), intent (in) :: alpha, beta
integer(psb_mpk_), intent (in) :: x(:)
integer(psb_mpk_), intent (inout) :: y(:)
integer(psb_mpk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: lx, ly
@ -127,7 +127,7 @@ subroutine psi_iaxpbyv(m,alpha, x, beta, y, info)
goto 9999
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)
return
@ -136,30 +136,30 @@ subroutine psi_iaxpbyv(m,alpha, x, beta, y, info)
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
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_ipk_) :: x(:,:), y(:),alpha,beta
integer(psb_mpk_) :: x(:,:), y(:),alpha,beta
! Locals
integer(psb_ipk_) :: i, j, pt
if (beta == izero) then
if (alpha == izero) then
if (beta == mzero) then
if (alpha == mzero) then
pt=0
do j=1,k
do i=1,n
pt=pt+1
y(pt) = izero
y(pt) = mzero
end do
end do
else if (alpha == ione) then
else if (alpha == mone) then
pt=0
do j=1,k
do i=1,n
@ -167,7 +167,7 @@ subroutine psi_igthmv(n,k,idx,alpha,x,beta,y)
y(pt) = x(idx(i),j)
end do
end do
else if (alpha == -ione) then
else if (alpha == -mone) then
pt=0
do j=1,k
do i=1,n
@ -185,17 +185,17 @@ subroutine psi_igthmv(n,k,idx,alpha,x,beta,y)
end do
end if
else
if (beta == ione) then
if (beta == mone) then
! Do nothing
else if (beta == -ione) then
else if (beta == -mone) then
y(1:n*k) = -y(1:n*k)
else
y(1:n*k) = beta*y(1:n*k)
end if
if (alpha == izero) then
if (alpha == mzero) then
! do nothing
else if (alpha == ione) then
else if (alpha == mone) then
pt=0
do j=1,k
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)
end do
end do
else if (alpha == -ione) then
else if (alpha == -mone) then
pt=0
do j=1,k
do i=1,n
@ -222,28 +222,28 @@ subroutine psi_igthmv(n,k,idx,alpha,x,beta,y)
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
implicit none
integer(psb_ipk_) :: n, idx(:)
integer(psb_ipk_) :: x(:), y(:),alpha,beta
integer(psb_mpk_) :: x(:), y(:),alpha,beta
! Locals
integer(psb_ipk_) :: i
if (beta == izero) then
if (alpha == izero) then
if (beta == mzero) then
if (alpha == mzero) then
do i=1,n
y(i) = izero
y(i) = mzero
end do
else if (alpha == ione) then
else if (alpha == mone) then
do i=1,n
y(i) = x(idx(i))
end do
else if (alpha == -ione) then
else if (alpha == -mone) then
do i=1,n
y(i) = -x(idx(i))
end do
@ -253,21 +253,21 @@ subroutine psi_igthv(n,idx,alpha,x,beta,y)
end do
end if
else
if (beta == ione) then
if (beta == mone) then
! Do nothing
else if (beta == -ione) then
else if (beta == -mone) then
y(1:n) = -y(1:n)
else
y(1:n) = beta*y(1:n)
end if
if (alpha == izero) then
if (alpha == mzero) then
! do nothing
else if (alpha == ione) then
else if (alpha == mone) then
do i=1,n
y(i) = y(i) + x(idx(i))
end do
else if (alpha == -ione) then
else if (alpha == -mone) then
do i=1,n
y(i) = y(i) - x(idx(i))
end do
@ -278,15 +278,15 @@ subroutine psi_igthv(n,idx,alpha,x,beta,y)
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
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_ipk_) :: x(:,:), y(:,:)
integer(psb_mpk_) :: x(:,:), y(:,:)
! Locals
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)
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
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_ipk_) :: x(:,:), y(:)
integer(psb_mpk_) :: x(:,:), y(:)
! Locals
integer(psb_ipk_) :: i, j, pt
@ -317,15 +317,15 @@ subroutine psi_igthzmv(n,k,idx,x,y)
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
implicit none
integer(psb_ipk_) :: n, idx(:)
integer(psb_ipk_) :: x(:), y(:)
integer(psb_mpk_) :: x(:), y(:)
! Locals
integer(psb_ipk_) :: i
@ -334,24 +334,24 @@ subroutine psi_igthzv(n,idx,x,y)
y(i)=x(idx(i))
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
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_ipk_) :: beta, x(:,:), y(:,:)
integer(psb_mpk_) :: beta, x(:,:), y(:,:)
! Locals
integer(psb_ipk_) :: i, j
if (beta == izero) then
if (beta == mzero) then
do i=1,n
y(idx(i),1:k) = x(i,1:k)
end do
else if (beta == ione) then
else if (beta == mone) then
do i=1,n
y(idx(i),1:k) = y(idx(i),1:k)+x(i,1:k)
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)
end do
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
implicit none
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_ipk_) :: beta, x(:), y(:,:)
integer(psb_mpk_) :: beta, x(:), y(:,:)
! Locals
integer(psb_ipk_) :: i, j, pt
if (beta == izero) then
if (beta == mzero) then
pt=0
do j=1,k
do i=1,n
@ -381,7 +381,7 @@ subroutine psi_isctmv(n,k,idx,x,beta,y)
y(idx(i),j) = x(pt)
end do
end do
else if (beta == ione) then
else if (beta == mone) then
pt=0
do j=1,k
do i=1,n
@ -398,24 +398,24 @@ subroutine psi_isctmv(n,k,idx,x,beta,y)
end do
end do
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
implicit none
integer(psb_ipk_) :: n, idx(:)
integer(psb_ipk_) :: beta, x(:), y(:)
integer(psb_mpk_) :: beta, x(:), y(:)
! Locals
integer(psb_ipk_) :: i
if (beta == izero) then
if (beta == mzero) then
do i=1,n
y(idx(i)) = x(i)
end do
else if (beta == ione) then
else if (beta == mone) then
do i=1,n
y(idx(i)) = y(idx(i))+x(i)
end do
@ -424,19 +424,19 @@ subroutine psi_isctv(n,idx,x,beta,y)
y(idx(i)) = beta*y(idx(i))+x(i)
end do
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_error_mod
implicit none
integer(psb_ipk_) :: n, m, lldx, lldy, info
integer(psb_ipk_) X(lldx,*), Y(lldy,*)
integer(psb_ipk_) alpha, beta
integer(psb_mpk_) X(lldx,*), Y(lldy,*)
integer(psb_mpk_) alpha, beta
integer(psb_ipk_) :: i, j
integer(psb_ipk_) :: int_err(5)
character name*20
name='iaxpby'
name='maxpby'
!
@ -473,19 +473,19 @@ subroutine iaxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
goto 9999
endif
if (alpha.eq.izero) then
if (beta.eq.izero) then
if (alpha.eq.mzero) then
if (beta.eq.mzero) then
do j=1, n
do i=1,m
y(i,j) = izero
y(i,j) = mzero
enddo
enddo
else if (beta.eq.ione) then
else if (beta.eq.mone) then
!
! Do nothing!
!
else if (beta.eq.-ione) then
else if (beta.eq.-mone) then
do j=1,n
do i=1,m
y(i,j) = - y(i,j)
@ -499,22 +499,22 @@ subroutine iaxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
enddo
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 i=1,m
y(i,j) = x(i,j)
enddo
enddo
else if (beta.eq.ione) then
else if (beta.eq.mone) then
do j=1,n
do i=1,m
y(i,j) = x(i,j) + y(i,j)
enddo
enddo
else if (beta.eq.-ione) then
else if (beta.eq.-mone) then
do j=1,n
do i=1,m
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
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 i=1,m
y(i,j) = -x(i,j)
enddo
enddo
else if (beta.eq.ione) then
else if (beta.eq.mone) then
do j=1,n
do i=1,m
y(i,j) = -x(i,j) + y(i,j)
enddo
enddo
else if (beta.eq.-ione) then
else if (beta.eq.-mone) then
do j=1,n
do i=1,m
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
if (beta.eq.izero) then
if (beta.eq.mzero) then
do j=1,n
do i=1,m
y(i,j) = alpha*x(i,j)
enddo
enddo
else if (beta.eq.ione) then
else if (beta.eq.mone) then
do j=1,n
do i=1,m
y(i,j) = alpha*x(i,j) + y(i,j)
enddo
enddo
else if (beta.eq.-ione) then
else if (beta.eq.-mone) then
do j=1,n
do i=1,m
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()
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
!
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
module procedure idx2ijk3d, idx2ijkv, idx2ijk2d,&
& lidx2ijk3d, lidx2ijkv, lidx2ijk2d,&
module procedure idx2ijk3d, idx2ijkv, idx2ijk2d
end interface idx2ijk
interface ijk2idx
module procedure ijk2idx3d, ijk2idxv, ijk2idx2d
end interface ijk2idx
interface idx2ijk
module procedure lidx2ijk3d, lidx2ijkv, lidx2ijk2d,&
& lidx2lijk3d, lidx2lijkv, lidx2lijk2d
end interface idx2ijk
interface ijk2idx
module procedure ijk2idx3d, ijk2idxv, ijk2idx2d,&
& ijk2lidx3d, ijk2lidxv, ijk2lidx2d,&
module procedure ijk2lidx3d, ijk2lidxv, ijk2lidx2d,&
& lijk2lidx3d, lijk2lidxv, lijk2lidx2d
end interface ijk2idx
contains
!
! Given a global index IDX and the domain size (NX,NY,NZ)
@ -67,13 +71,13 @@ contains
! ijk2idx(i,j,k) = idx
! idx = idx + 1
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
integer(psb_ipk_), intent(out) :: i,j,k
integer(psb_ipk_), intent(in) :: idx,nx,ny,nz
integer(psb_ipk_), intent(in), optional :: base
integer(psb_mpk_), intent(out) :: i,j,k
integer(psb_mpk_), intent(in) :: idx,nx,ny,nz
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)
@ -84,13 +88,13 @@ contains
end subroutine idx2ijk3d
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
integer(psb_ipk_), intent(out) :: i,j
integer(psb_ipk_), intent(in) :: idx,nx,ny
integer(psb_ipk_), intent(in), optional :: base
integer(psb_mpk_), intent(out) :: i,j
integer(psb_mpk_), intent(in) :: idx,nx,ny
integer(psb_mpk_), intent(in), optional :: base
integer(psb_ipk_) :: coords(2)
integer(psb_mpk_) :: coords(2)
call idx2ijk(coords,idx,[nx,ny],base)
@ -112,13 +116,13 @@ contains
! ijk2idx(i,j,k) = idx
! idx = idx + 1
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
integer(psb_ipk_), intent(out) :: coords(:)
integer(psb_ipk_), intent(in) :: idx,dims(:)
integer(psb_ipk_), intent(in), optional :: base
integer(psb_mpk_), intent(out) :: coords(:)
integer(psb_mpk_), intent(in) :: idx,dims(:)
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
base_ = base
else
@ -147,14 +151,14 @@ contains
end subroutine idx2ijkv
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
integer(psb_ipk_), intent(out) :: i,j,k
integer(psb_lpk_), intent(in) :: idx
integer(psb_ipk_), intent(in) :: nx,ny,nz
integer(psb_ipk_), intent(in), optional :: base
integer(psb_mpk_), intent(out) :: i,j,k
integer(psb_epk_), intent(in) :: idx
integer(psb_mpk_), intent(in) :: nx,ny,nz
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)
@ -165,14 +169,14 @@ contains
end subroutine lidx2ijk3d
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
integer(psb_ipk_), intent(out) :: i,j
integer(psb_lpk_), intent(in) :: idx
integer(psb_ipk_), intent(in) :: nx,ny
integer(psb_ipk_), intent(in), optional :: base
integer(psb_mpk_), intent(out) :: i,j
integer(psb_epk_), intent(in) :: idx
integer(psb_mpk_), intent(in) :: nx,ny
integer(psb_mpk_), intent(in), optional :: base
integer(psb_ipk_) :: coords(2)
integer(psb_mpk_) :: coords(2)
call idx2ijk(coords,idx,[nx,ny],base)
@ -194,15 +198,15 @@ contains
! ijk2idx(i,j,k) = idx
! idx = idx + 1
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
integer(psb_ipk_), intent(out) :: coords(:)
integer(psb_lpk_), intent(in) :: idx
integer(psb_ipk_), intent(in) :: dims(:)
integer(psb_ipk_), intent(in), optional :: base
integer(psb_mpk_), intent(out) :: coords(:)
integer(psb_epk_), intent(in) :: idx
integer(psb_mpk_), intent(in) :: dims(:)
integer(psb_mpk_), intent(in), optional :: base
integer(psb_lpk_) :: base_, idx_
integer(psb_ipk_) :: i, sz
integer(psb_epk_) :: base_, idx_
integer(psb_mpk_) :: i, sz
if (present(base)) then
base_ = base
else
@ -231,14 +235,14 @@ contains
end subroutine lidx2ijkv
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
integer(psb_lpk_), intent(out) :: i,j,k
integer(psb_lpk_), intent(in) :: idx
integer(psb_lpk_), intent(in) :: nx,ny,nz
integer(psb_ipk_), intent(in), optional :: base
integer(psb_epk_), intent(out) :: i,j,k
integer(psb_epk_), intent(in) :: idx
integer(psb_epk_), intent(in) :: nx,ny,nz
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)
@ -249,14 +253,14 @@ contains
end subroutine lidx2lijk3d
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
integer(psb_lpk_), intent(out) :: i,j
integer(psb_lpk_), intent(in) :: idx
integer(psb_lpk_), intent(in) :: nx,ny
integer(psb_ipk_), intent(in), optional :: base
integer(psb_epk_), intent(out) :: i,j
integer(psb_epk_), intent(in) :: idx
integer(psb_epk_), intent(in) :: nx,ny
integer(psb_mpk_), intent(in), optional :: base
integer(psb_lpk_) :: coords(2)
integer(psb_epk_) :: coords(2)
call idx2ijk(coords,idx,[nx,ny],base)
@ -278,15 +282,15 @@ contains
! ijk2idx(i,j,k) = idx
! idx = idx + 1
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
integer(psb_lpk_), intent(out) :: coords(:)
integer(psb_lpk_), intent(in) :: idx
integer(psb_lpk_), intent(in) :: dims(:)
integer(psb_ipk_), intent(in), optional :: base
integer(psb_epk_), intent(out) :: coords(:)
integer(psb_epk_), intent(in) :: idx
integer(psb_epk_), intent(in) :: dims(:)
integer(psb_mpk_), intent(in), optional :: base
integer(psb_lpk_) :: base_, idx_
integer(psb_lpk_) :: i, sz
integer(psb_epk_) :: base_, idx_
integer(psb_epk_) :: i, sz
if (present(base)) then
base_ = base
else
@ -313,7 +317,6 @@ contains
end do
end subroutine lidx2lijkv
!
! Given a triple (I,J,K) and the domain size (NX,NY,NZ)
! compute the global index IDX
@ -327,13 +330,13 @@ contains
! ijk2idx(i,j,k) = idx
! idx = idx + 1
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
integer(psb_ipk_), intent(in) :: coords(:),dims(:)
integer(psb_ipk_), intent(out) :: idx
integer(psb_ipk_), intent(in), optional :: base
integer(psb_mpk_), intent(in) :: coords(:),dims(:)
integer(psb_mpk_), intent(out) :: idx
integer(psb_mpk_), intent(in), optional :: base
integer(psb_ipk_) :: base_, i, sz
integer(psb_mpk_) :: base_, i, sz
if (present(base)) then
base_ = base
else
@ -366,35 +369,35 @@ contains
! ijk2idx(i,j,k) = idx
! idx = idx + 1
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
integer(psb_ipk_), intent(out) :: idx
integer(psb_ipk_), intent(in) :: i,j,k,nx,ny,nz
integer(psb_ipk_), intent(in), optional :: base
integer(psb_mpk_), intent(out) :: idx
integer(psb_mpk_), intent(in) :: i,j,k,nx,ny,nz
integer(psb_mpk_), intent(in), optional :: base
! idx = ((i-base_)*nz*ny + (j-base_)*nz + k - base_) + base_
call ijk2idx(idx,[i,j,k],[nx,ny,nz],base)
end subroutine ijk2idx3d
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
integer(psb_ipk_), intent(out) :: idx
integer(psb_ipk_), intent(in) :: i,j,nx,ny
integer(psb_ipk_), intent(in), optional :: base
integer(psb_mpk_), intent(out) :: idx
integer(psb_mpk_), intent(in) :: i,j,nx,ny
integer(psb_mpk_), intent(in), optional :: base
! idx = ((i-base_)*ny + (j-base_) + base_
call ijk2idx(idx,[i,j],[nx,ny],base)
end subroutine ijk2idx2d
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
integer(psb_ipk_), intent(in) :: coords(:),dims(:)
integer(psb_lpk_), intent(out) :: idx
integer(psb_ipk_), intent(in), optional :: base
integer(psb_mpk_), intent(in) :: coords(:),dims(:)
integer(psb_epk_), intent(out) :: idx
integer(psb_mpk_), intent(in), optional :: base
integer(psb_ipk_) :: base_, i, sz
integer(psb_mpk_) :: base_, i, sz
if (present(base)) then
base_ = base
else
@ -427,22 +430,22 @@ contains
! ijk2idx(i,j,k) = idx
! idx = idx + 1
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
integer(psb_lpk_), intent(out) :: idx
integer(psb_ipk_), intent(in) :: i,j,k,nx,ny,nz
integer(psb_ipk_), intent(in), optional :: base
integer(psb_epk_), intent(out) :: idx
integer(psb_mpk_), intent(in) :: i,j,k,nx,ny,nz
integer(psb_mpk_), intent(in), optional :: base
! idx = ((i-base_)*nz*ny + (j-base_)*nz + k - base_) + base_
call ijk2idx(idx,[i,j,k],[nx,ny,nz],base)
end subroutine ijk2lidx3d
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
integer(psb_lpk_), intent(out) :: idx
integer(psb_ipk_), intent(in) :: i,j,nx,ny
integer(psb_ipk_), intent(in), optional :: base
integer(psb_epk_), intent(out) :: idx
integer(psb_mpk_), intent(in) :: i,j,nx,ny
integer(psb_mpk_), intent(in), optional :: base
! idx = ((i-base_)*ny + (j-base_) + base_
call ijk2idx(idx,[i,j],[nx,ny],base)
@ -450,13 +453,13 @@ contains
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
integer(psb_lpk_), intent(in) :: coords(:),dims(:)
integer(psb_lpk_), intent(out) :: idx
integer(psb_ipk_), intent(in), optional :: base
integer(psb_epk_), intent(in) :: coords(:),dims(:)
integer(psb_epk_), intent(out) :: idx
integer(psb_mpk_), intent(in), optional :: base
integer(psb_lpk_) :: base_, i, sz
integer(psb_epk_) :: base_, i, sz
if (present(base)) then
base_ = base
else
@ -489,27 +492,26 @@ contains
! ijk2idx(i,j,k) = idx
! idx = idx + 1
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
integer(psb_lpk_), intent(out) :: idx
integer(psb_lpk_), intent(in) :: i,j,k,nx,ny,nz
integer(psb_ipk_), intent(in), optional :: base
integer(psb_epk_), intent(out) :: idx
integer(psb_epk_), intent(in) :: i,j,k,nx,ny,nz
integer(psb_mpk_), intent(in), optional :: base
! idx = ((i-base_)*nz*ny + (j-base_)*nz + k - base_) + base_
call ijk2idx(idx,[i,j,k],[nx,ny,nz],base)
end subroutine lijk2lidx3d
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
integer(psb_lpk_), intent(out) :: idx
integer(psb_lpk_), intent(in) :: i,j,nx,ny
integer(psb_ipk_), intent(in), optional :: base
integer(psb_epk_), intent(out) :: idx
integer(psb_epk_), intent(in) :: i,j,nx,ny
integer(psb_mpk_), intent(in), optional :: base
! idx = ((i-base_)*ny + (j-base_) + base_
call ijk2idx(idx,[i,j],[nx,ny],base)
end subroutine lijk2lidx2d
!
! dist1Didx
@ -523,7 +525,7 @@ contains
! V(P+1) : first index owned by process P+1
!
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
integer(psb_ipk_), intent(out) :: v(:)
integer(psb_ipk_), intent(in) :: n, np

Write Preview
Loading…
Cancel
Save