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

Change name of ICTXT to CTXT

Browse Source
new-context
Salvatore Filippone 4 years ago
parent 8b2b86d44d
commit 6a6f6ad2c2
470 changed files with 7601 additions and 7601 deletions
Show Stats Download Patch File Download Diff File

16
base/comm/internals/psi_covrl_restr.f90
Unescape Escape View File

@ -47,7 +47,7 @@ subroutine psi_covrl_restr_vect(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz integer(psb_ipk_) :: np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -57,8 +57,8 @@ subroutine psi_covrl_restr_vect(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -72,7 +72,7 @@ subroutine psi_covrl_restr_vect(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_covrl_restr_vect end subroutine psi_covrl_restr_vect
@ -90,7 +90,7 @@ subroutine psi_covrl_restr_multivect(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -100,8 +100,8 @@ subroutine psi_covrl_restr_multivect(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -114,7 +114,7 @@ subroutine psi_covrl_restr_multivect(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_covrl_restr_multivect end subroutine psi_covrl_restr_multivect

16
base/comm/internals/psi_covrl_restr_a.f90
Unescape Escape View File

@ -45,7 +45,7 @@ subroutine psi_covrl_restrr1(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz integer(psb_ipk_) :: np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -55,8 +55,8 @@ subroutine psi_covrl_restrr1(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -73,7 +73,7 @@ subroutine psi_covrl_restrr1(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_covrl_restrr1 end subroutine psi_covrl_restrr1
@ -89,7 +89,7 @@ subroutine psi_covrl_restrr2(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz integer(psb_ipk_) :: np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -99,8 +99,8 @@ subroutine psi_covrl_restrr2(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -124,7 +124,7 @@ subroutine psi_covrl_restrr2(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_covrl_restrr2 end subroutine psi_covrl_restrr2

16
base/comm/internals/psi_covrl_save.f90
Unescape Escape View File

@ -47,7 +47,7 @@ subroutine psi_covrl_save_vect(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz integer(psb_ipk_) :: np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -57,8 +57,8 @@ subroutine psi_covrl_save_vect(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -78,7 +78,7 @@ subroutine psi_covrl_save_vect(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_covrl_save_vect end subroutine psi_covrl_save_vect
@ -96,7 +96,7 @@ subroutine psi_covrl_save_multivect(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -106,8 +106,8 @@ subroutine psi_covrl_save_multivect(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -128,7 +128,7 @@ subroutine psi_covrl_save_multivect(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_covrl_save_multivect end subroutine psi_covrl_save_multivect

16
base/comm/internals/psi_covrl_save_a.f90
Unescape Escape View File

@ -47,7 +47,7 @@ subroutine psi_covrl_saver1(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz integer(psb_ipk_) :: np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -57,8 +57,8 @@ subroutine psi_covrl_saver1(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -81,7 +81,7 @@ subroutine psi_covrl_saver1(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_covrl_saver1 end subroutine psi_covrl_saver1
@ -100,7 +100,7 @@ subroutine psi_covrl_saver2(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -110,8 +110,8 @@ subroutine psi_covrl_saver2(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -135,7 +135,7 @@ subroutine psi_covrl_saver2(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_covrl_saver2 end subroutine psi_covrl_saver2

16
base/comm/internals/psi_covrl_upd.f90
Unescape Escape View File

@ -50,7 +50,7 @@ subroutine psi_covrl_upd_vect(x,desc_a,update,info)
! locals ! locals
complex(psb_spk_), allocatable :: xs(:) complex(psb_spk_), allocatable :: xs(:)
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -62,8 +62,8 @@ subroutine psi_covrl_upd_vect(x,desc_a,update,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -113,7 +113,7 @@ subroutine psi_covrl_upd_vect(x,desc_a,update,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_covrl_upd_vect end subroutine psi_covrl_upd_vect
@ -132,7 +132,7 @@ subroutine psi_covrl_upd_multivect(x,desc_a,update,info)
! locals ! locals
complex(psb_spk_), allocatable :: xs(:,:) complex(psb_spk_), allocatable :: xs(:,:)
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx, nc integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx, nc
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -144,8 +144,8 @@ subroutine psi_covrl_upd_multivect(x,desc_a,update,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -196,7 +196,7 @@ subroutine psi_covrl_upd_multivect(x,desc_a,update,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_covrl_upd_multivect end subroutine psi_covrl_upd_multivect

16
base/comm/internals/psi_covrl_upd_a.f90
Unescape Escape View File

@ -46,7 +46,7 @@ subroutine psi_covrl_updr1(x,desc_a,update,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, ndm integer(psb_ipk_) :: np, me, err_act, i, idx, ndm
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -57,8 +57,8 @@ subroutine psi_covrl_updr1(x,desc_a,update,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -99,7 +99,7 @@ subroutine psi_covrl_updr1(x,desc_a,update,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_covrl_updr1 end subroutine psi_covrl_updr1
@ -115,7 +115,7 @@ subroutine psi_covrl_updr2(x,desc_a,update,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, ndm integer(psb_ipk_) :: np, me, err_act, i, idx, ndm
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -126,8 +126,8 @@ subroutine psi_covrl_updr2(x,desc_a,update,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -168,7 +168,7 @@ subroutine psi_covrl_updr2(x,desc_a,update,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_covrl_updr2 end subroutine psi_covrl_updr2

48
base/comm/internals/psi_cswapdata.F90
Unescape Escape View File

@ -113,7 +113,7 @@ subroutine psi_cswapdata_vect(flag,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act
class(psb_i_base_vect_type), pointer :: d_vidx class(psb_i_base_vect_type), pointer :: d_vidx
@ -123,9 +123,9 @@ subroutine psi_cswapdata_vect(flag,beta,y,desc_a,work,info,data)
name='psi_swap_datav' name='psi_swap_datav'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -150,13 +150,13 @@ subroutine psi_cswapdata_vect(flag,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swapdata(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) call psi_swapdata(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_cswapdata_vect end subroutine psi_cswapdata_vect
@ -175,7 +175,7 @@ end subroutine psi_cswapdata_vect
! !
! !
! !
subroutine psi_cswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & subroutine psi_cswap_vidx_vect(ictxt,iicomm,flag,beta,y,idx, &
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_cswap_vidx_vect use psi_mod, psb_protect_name => psi_cswap_vidx_vect
@ -192,7 +192,7 @@ subroutine psi_cswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: iictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: iicomm integer(psb_mpk_), intent(in) :: iicomm
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -203,7 +203,7 @@ subroutine psi_cswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm, np, me,& integer(psb_mpk_) :: icomm, np, me,&
& proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable :: prcid(:) integer(psb_mpk_), allocatable :: prcid(:)
@ -218,10 +218,10 @@ subroutine psi_cswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
info=psb_success_ info=psb_success_
name='psi_swap_datav' name='psi_swap_datav'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = iictxt ctxt = ictxt
icomm = iicomm icomm = iicomm
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -265,7 +265,7 @@ subroutine psi_cswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
nesd = idx%v(pnti+nerv+psb_n_elem_send_) nesd = idx%v(pnti+nerv+psb_n_elem_send_)
rcv_pt = 1+pnti+psb_n_elem_recv_ rcv_pt = 1+pnti+psb_n_elem_recv_
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt
p2ptag = psb_complex_swap_tag p2ptag = psb_complex_swap_tag
@ -418,7 +418,7 @@ subroutine psi_cswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_cswap_vidx_vect end subroutine psi_cswap_vidx_vect
@ -455,7 +455,7 @@ subroutine psi_cswapdata_multivect(flag,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act
class(psb_i_base_vect_type), pointer :: d_vidx class(psb_i_base_vect_type), pointer :: d_vidx
@ -465,9 +465,9 @@ subroutine psi_cswapdata_multivect(flag,beta,y,desc_a,work,info,data)
name='psi_swap_datav' name='psi_swap_datav'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -492,13 +492,13 @@ subroutine psi_cswapdata_multivect(flag,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swapdata(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) call psi_swapdata(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_cswapdata_multivect end subroutine psi_cswapdata_multivect
@ -517,7 +517,7 @@ end subroutine psi_cswapdata_multivect
! !
! !
! !
subroutine psi_cswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & subroutine psi_cswap_vidx_multivect(ictxt,iicomm,flag,beta,y,idx, &
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_cswap_vidx_multivect use psi_mod, psb_protect_name => psi_cswap_vidx_multivect
@ -534,7 +534,7 @@ subroutine psi_cswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: iictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: iicomm integer(psb_mpk_), intent(in) :: iicomm
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -545,7 +545,7 @@ subroutine psi_cswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm, np, me,& integer(psb_mpk_) :: icomm, np, me,&
& proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable :: prcid(:) integer(psb_mpk_), allocatable :: prcid(:)
@ -560,10 +560,10 @@ subroutine psi_cswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
info=psb_success_ info=psb_success_
name='psi_swap_datav' name='psi_swap_datav'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = iictxt ctxt = ictxt
icomm = iicomm icomm = iicomm
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -609,7 +609,7 @@ subroutine psi_cswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
proc_to_comm = idx%v(pnti+psb_proc_id_) proc_to_comm = idx%v(pnti+psb_proc_id_)
nerv = idx%v(pnti+psb_n_elem_recv_) nerv = idx%v(pnti+psb_n_elem_recv_)
nesd = idx%v(pnti+nerv+psb_n_elem_send_) nesd = idx%v(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt
p2ptag = psb_complex_swap_tag p2ptag = psb_complex_swap_tag
@ -766,7 +766,7 @@ subroutine psi_cswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_cswap_vidx_multivect end subroutine psi_cswap_vidx_multivect

72
base/comm/internals/psi_cswapdata_a.F90
Unescape Escape View File

@ -106,7 +106,7 @@ subroutine psi_cswapdatam(flag,n,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act
integer(psb_ipk_), pointer :: d_idx(:) integer(psb_ipk_), pointer :: d_idx(:)
@ -116,9 +116,9 @@ subroutine psi_cswapdatam(flag,n,beta,y,desc_a,work,info,data)
name='psi_swap_data' name='psi_swap_data'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -143,18 +143,18 @@ subroutine psi_cswapdatam(flag,n,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swapdata(ictxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info) call psi_swapdata(ctxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_cswapdatam end subroutine psi_cswapdatam
subroutine psi_cswapidxm(ictxt,icomm,flag,n,beta,y,idx, & subroutine psi_cswapidxm(ctxt,icomm,flag,n,beta,y,idx, &
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_cswapidxm use psi_mod, psb_protect_name => psi_cswapidxm
@ -169,7 +169,7 @@ subroutine psi_cswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: icomm integer(psb_mpk_), intent(in) :: icomm
integer(psb_ipk_), intent(in) :: flag,n integer(psb_ipk_), intent(in) :: flag,n
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -198,7 +198,7 @@ subroutine psi_cswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
name='psi_swap_data' name='psi_swap_data'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -238,7 +238,7 @@ subroutine psi_cswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm)
brvidx(proc_to_comm) = rcv_pt brvidx(proc_to_comm) = rcv_pt
rvsz(proc_to_comm) = n*nerv rvsz(proc_to_comm) = n*nerv
@ -317,14 +317,14 @@ subroutine psi_cswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (proc_to_comm < me) then if (proc_to_comm < me) then
if (nesd>0) call psb_snd(ictxt,& if (nesd>0) call psb_snd(ctxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
if (nerv>0) call psb_rcv(ictxt,& if (nerv>0) call psb_rcv(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
else if (proc_to_comm > me) then else if (proc_to_comm > me) then
if (nerv>0) call psb_rcv(ictxt,& if (nerv>0) call psb_rcv(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
if (nesd>0) call psb_snd(ictxt,& if (nesd>0) call psb_snd(ctxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
else if (proc_to_comm == me) then else if (proc_to_comm == me) then
if (nesd /= nerv) then if (nesd /= nerv) then
@ -351,7 +351,7 @@ subroutine psi_cswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_complex_swap_tag p2ptag = psb_complex_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),n*nerv,& call mpi_irecv(rcvbuf(rcv_pt),n*nerv,&
@ -436,7 +436,7 @@ subroutine psi_cswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nesd>0) call psb_snd(ictxt,& if (nesd>0) call psb_snd(ctxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
rcv_pt = rcv_pt + n*nerv rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd snd_pt = snd_pt + n*nesd
@ -453,7 +453,7 @@ subroutine psi_cswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nerv>0) call psb_rcv(ictxt,& if (nerv>0) call psb_rcv(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
rcv_pt = rcv_pt + n*nerv rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd snd_pt = snd_pt + n*nesd
@ -501,7 +501,7 @@ subroutine psi_cswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_cswapidxm end subroutine psi_cswapidxm
@ -582,7 +582,7 @@ subroutine psi_cswapdatav(flag,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act
integer(psb_ipk_), pointer :: d_idx(:) integer(psb_ipk_), pointer :: d_idx(:)
@ -592,9 +592,9 @@ subroutine psi_cswapdatav(flag,beta,y,desc_a,work,info,data)
name='psi_swap_datav' name='psi_swap_datav'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -619,13 +619,13 @@ subroutine psi_cswapdatav(flag,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swapdata(ictxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) call psi_swapdata(ctxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_cswapdatav end subroutine psi_cswapdatav
@ -641,7 +641,7 @@ end subroutine psi_cswapdatav
! !
! !
! !
subroutine psi_cswapidxv(iictxt,iicomm,flag,beta,y,idx, & subroutine psi_cswapidxv(ictxt,iicomm,flag,beta,y,idx, &
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_cswapidxv use psi_mod, psb_protect_name => psi_cswapidxv
@ -656,7 +656,7 @@ subroutine psi_cswapidxv(iictxt,iicomm,flag,beta,y,idx, &
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: iictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: iicomm integer(psb_mpk_), intent(in) :: iicomm
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -665,7 +665,7 @@ subroutine psi_cswapidxv(iictxt,iicomm,flag,beta,y,idx, &
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm, np, me,& integer(psb_mpk_) :: icomm, np, me,&
& proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
@ -684,10 +684,10 @@ subroutine psi_cswapidxv(iictxt,iicomm,flag,beta,y,idx, &
info=psb_success_ info=psb_success_
name='psi_swap_datav' name='psi_swap_datav'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = iictxt ctxt = ictxt
icomm = iicomm icomm = iicomm
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -727,7 +727,7 @@ subroutine psi_cswapidxv(iictxt,iicomm,flag,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm)
brvidx(proc_to_comm) = rcv_pt brvidx(proc_to_comm) = rcv_pt
rvsz(proc_to_comm) = nerv rvsz(proc_to_comm) = nerv
@ -807,14 +807,14 @@ subroutine psi_cswapidxv(iictxt,iicomm,flag,beta,y,idx, &
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (proc_to_comm < me) then if (proc_to_comm < me) then
if (nesd>0) call psb_snd(ictxt,& if (nesd>0) call psb_snd(ctxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
if (nerv>0) call psb_rcv(ictxt,& if (nerv>0) call psb_rcv(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
else if (proc_to_comm > me) then else if (proc_to_comm > me) then
if (nerv>0) call psb_rcv(ictxt,& if (nerv>0) call psb_rcv(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
if (nesd>0) call psb_snd(ictxt,& if (nesd>0) call psb_snd(ctxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
else if (proc_to_comm == me) then else if (proc_to_comm == me) then
if (nesd /= nerv) then if (nesd /= nerv) then
@ -841,7 +841,7 @@ subroutine psi_cswapidxv(iictxt,iicomm,flag,beta,y,idx, &
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_complex_swap_tag p2ptag = psb_complex_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),nerv,& call mpi_irecv(rcvbuf(rcv_pt),nerv,&
@ -925,7 +925,7 @@ subroutine psi_cswapidxv(iictxt,iicomm,flag,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nesd>0) call psb_snd(ictxt,& if (nesd>0) call psb_snd(ctxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd snd_pt = snd_pt + nesd
@ -941,7 +941,7 @@ subroutine psi_cswapidxv(iictxt,iicomm,flag,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nerv>0) call psb_rcv(ictxt,& if (nerv>0) call psb_rcv(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd snd_pt = snd_pt + nesd
@ -988,7 +988,7 @@ subroutine psi_cswapidxv(iictxt,iicomm,flag,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_cswapidxv end subroutine psi_cswapidxv

48
base/comm/internals/psi_cswaptran.F90
Unescape Escape View File

@ -115,7 +115,7 @@ subroutine psi_cswaptran_vect(flag,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_
class(psb_i_base_vect_type), pointer :: d_vidx class(psb_i_base_vect_type), pointer :: d_vidx
@ -125,9 +125,9 @@ subroutine psi_cswaptran_vect(flag,beta,y,desc_a,work,info,data)
name='psi_swap_tranv' name='psi_swap_tranv'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -152,13 +152,13 @@ subroutine psi_cswaptran_vect(flag,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swaptran(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) call psi_swaptran(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_cswaptran_vect end subroutine psi_cswaptran_vect
@ -176,7 +176,7 @@ end subroutine psi_cswaptran_vect
! !
! !
! !
subroutine psi_ctran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& subroutine psi_ctran_vidx_vect(ictxt,iicomm,flag,beta,y,idx,&
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_ctran_vidx_vect use psi_mod, psb_protect_name => psi_ctran_vidx_vect
@ -193,7 +193,7 @@ subroutine psi_ctran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: iictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: iicomm integer(psb_mpk_), intent(in) :: iicomm
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -204,7 +204,7 @@ subroutine psi_ctran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm, np, me,& integer(psb_mpk_) :: icomm, np, me,&
& proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable :: prcid(:) integer(psb_mpk_), allocatable :: prcid(:)
@ -219,10 +219,10 @@ subroutine psi_ctran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
info=psb_success_ info=psb_success_
name='psi_swap_tran' name='psi_swap_tran'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = iictxt ctxt = ictxt
icomm = iicomm icomm = iicomm
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -269,7 +269,7 @@ subroutine psi_ctran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
snd_pt = 1+pnti+nerv+psb_n_elem_send_ snd_pt = 1+pnti+nerv+psb_n_elem_send_
rcv_pt = 1+pnti+psb_n_elem_recv_ rcv_pt = 1+pnti+psb_n_elem_recv_
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt
call mpi_irecv(y%combuf(snd_pt),nesd,& call mpi_irecv(y%combuf(snd_pt),nesd,&
@ -425,7 +425,7 @@ subroutine psi_ctran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
@ -466,7 +466,7 @@ subroutine psi_cswaptran_multivect(flag,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_
class(psb_i_base_vect_type), pointer :: d_vidx class(psb_i_base_vect_type), pointer :: d_vidx
@ -476,9 +476,9 @@ subroutine psi_cswaptran_multivect(flag,beta,y,desc_a,work,info,data)
name='psi_swap_tranv' name='psi_swap_tranv'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -503,13 +503,13 @@ subroutine psi_cswaptran_multivect(flag,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swaptran(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) call psi_swaptran(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_cswaptran_multivect end subroutine psi_cswaptran_multivect
@ -528,7 +528,7 @@ subroutine psi_cswaptran_multivect(flag,beta,y,desc_a,work,info,data)
! !
! !
! !
subroutine psi_ctran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& subroutine psi_ctran_vidx_multivect(ictxt,iicomm,flag,beta,y,idx,&
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_ctran_vidx_multivect use psi_mod, psb_protect_name => psi_ctran_vidx_multivect
@ -545,7 +545,7 @@ subroutine psi_ctran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: iictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: iicomm integer(psb_mpk_), intent(in) :: iicomm
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -556,7 +556,7 @@ subroutine psi_ctran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm, np, me,& integer(psb_mpk_) :: icomm, np, me,&
& proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable :: prcid(:) integer(psb_mpk_), allocatable :: prcid(:)
@ -571,10 +571,10 @@ subroutine psi_ctran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
info=psb_success_ info=psb_success_
name='psi_swap_tran' name='psi_swap_tran'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = iictxt ctxt = ictxt
icomm = iicomm icomm = iicomm
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -621,7 +621,7 @@ subroutine psi_ctran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
proc_to_comm = idx%v(pnti+psb_proc_id_) proc_to_comm = idx%v(pnti+psb_proc_id_)
nerv = idx%v(pnti+psb_n_elem_recv_) nerv = idx%v(pnti+psb_n_elem_recv_)
nesd = idx%v(pnti+nerv+psb_n_elem_send_) nesd = idx%v(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
if (debug) write(*,*) me,'Posting receive from',prcid(i),snd_pt if (debug) write(*,*) me,'Posting receive from',prcid(i),snd_pt
call mpi_irecv(y%combuf(snd_pt),n*nesd,& call mpi_irecv(y%combuf(snd_pt),n*nesd,&
@ -781,7 +781,7 @@ subroutine psi_ctran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return

76
base/comm/internals/psi_cswaptran_a.F90
Unescape Escape View File

@ -110,7 +110,7 @@ subroutine psi_cswaptranm(flag,n,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, err_act, totxch, data_ integer(psb_ipk_) :: np, me, idxs, idxr, err_act, totxch, data_
integer(psb_ipk_), pointer :: d_idx(:) integer(psb_ipk_), pointer :: d_idx(:)
@ -120,10 +120,10 @@ subroutine psi_cswaptranm(flag,n,beta,y,desc_a,work,info,data)
name='psi_swap_tran' name='psi_swap_tran'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -148,18 +148,18 @@ subroutine psi_cswaptranm(flag,n,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swaptran(ictxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info) call psi_swaptran(ctxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_cswaptranm end subroutine psi_cswaptranm
subroutine psi_ctranidxm(iictxt,iicomm,flag,n,beta,y,idx,& subroutine psi_ctranidxm(ictxt,iicomm,flag,n,beta,y,idx,&
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_ctranidxm use psi_mod, psb_protect_name => psi_ctranidxm
@ -174,7 +174,7 @@ subroutine psi_ctranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: iictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: iicomm integer(psb_mpk_), intent(in) :: iicomm
integer(psb_ipk_), intent(in) :: flag,n integer(psb_ipk_), intent(in) :: flag,n
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -183,7 +183,7 @@ subroutine psi_ctranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm, np, me,& integer(psb_mpk_) :: icomm, np, me,&
& proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
@ -202,10 +202,10 @@ subroutine psi_ctranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
info=psb_success_ info=psb_success_
name='psi_swap_tran' name='psi_swap_tran'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = iictxt ctxt = ictxt
icomm = iicomm icomm = iicomm
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -245,7 +245,7 @@ subroutine psi_ctranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm)
brvidx(proc_to_comm) = rcv_pt brvidx(proc_to_comm) = rcv_pt
rvsz(proc_to_comm) = n*nerv rvsz(proc_to_comm) = n*nerv
@ -329,14 +329,14 @@ subroutine psi_ctranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (proc_to_comm < me) then if (proc_to_comm < me) then
if (nerv>0) call psb_snd(ictxt,& if (nerv>0) call psb_snd(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
if (nesd>0) call psb_rcv(ictxt,& if (nesd>0) call psb_rcv(ctxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
else if (proc_to_comm > me) then else if (proc_to_comm > me) then
if (nesd>0) call psb_rcv(ictxt,& if (nesd>0) call psb_rcv(ctxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
if (nerv>0) call psb_snd(ictxt,& if (nerv>0) call psb_snd(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
else if (proc_to_comm == me) then else if (proc_to_comm == me) then
if (nesd /= nerv) then if (nesd /= nerv) then
@ -363,7 +363,7 @@ subroutine psi_ctranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
p2ptag = psb_complex_swap_tag p2ptag = psb_complex_swap_tag
call mpi_irecv(sndbuf(snd_pt),n*nesd,& call mpi_irecv(sndbuf(snd_pt),n*nesd,&
@ -448,7 +448,7 @@ subroutine psi_ctranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nerv>0) call psb_snd(ictxt,& if (nerv>0) call psb_snd(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
rcv_pt = rcv_pt + n*nerv rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd snd_pt = snd_pt + n*nesd
@ -465,7 +465,7 @@ subroutine psi_ctranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nesd>0) call psb_rcv(ictxt,& if (nesd>0) call psb_rcv(ctxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
rcv_pt = rcv_pt + n*nerv rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd snd_pt = snd_pt + n*nesd
@ -513,7 +513,7 @@ subroutine psi_ctranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_ctranidxm end subroutine psi_ctranidxm
@ -597,7 +597,7 @@ subroutine psi_cswaptranv(flag,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_
integer(psb_ipk_), pointer :: d_idx(:) integer(psb_ipk_), pointer :: d_idx(:)
@ -607,9 +607,9 @@ subroutine psi_cswaptranv(flag,beta,y,desc_a,work,info,data)
name='psi_swap_tranv' name='psi_swap_tranv'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -634,13 +634,13 @@ subroutine psi_cswaptranv(flag,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swaptran(ictxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) call psi_swaptran(ctxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_cswaptranv end subroutine psi_cswaptranv
@ -656,7 +656,7 @@ end subroutine psi_cswaptranv
! !
! !
! !
subroutine psi_ctranidxv(iictxt,iicomm,flag,beta,y,idx,& subroutine psi_ctranidxv(ictxt,iicomm,flag,beta,y,idx,&
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_ctranidxv use psi_mod, psb_protect_name => psi_ctranidxv
@ -671,7 +671,7 @@ subroutine psi_ctranidxv(iictxt,iicomm,flag,beta,y,idx,&
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: iictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: iicomm integer(psb_mpk_), intent(in) :: iicomm
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -680,7 +680,7 @@ subroutine psi_ctranidxv(iictxt,iicomm,flag,beta,y,idx,&
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm, np, me,& integer(psb_mpk_) :: icomm, np, me,&
& proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
@ -699,10 +699,10 @@ subroutine psi_ctranidxv(iictxt,iicomm,flag,beta,y,idx,&
info=psb_success_ info=psb_success_
name='psi_swap_tran' name='psi_swap_tran'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = iictxt ctxt = ictxt
icomm = iicomm icomm = iicomm
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -742,7 +742,7 @@ subroutine psi_ctranidxv(iictxt,iicomm,flag,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm)
brvidx(proc_to_comm) = rcv_pt brvidx(proc_to_comm) = rcv_pt
rvsz(proc_to_comm) = nerv rvsz(proc_to_comm) = nerv
@ -827,14 +827,14 @@ subroutine psi_ctranidxv(iictxt,iicomm,flag,beta,y,idx,&
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (proc_to_comm < me) then if (proc_to_comm < me) then
if (nerv>0) call psb_snd(ictxt,& if (nerv>0) call psb_snd(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
if (nesd>0) call psb_rcv(ictxt,& if (nesd>0) call psb_rcv(ctxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
else if (proc_to_comm > me) then else if (proc_to_comm > me) then
if (nesd>0) call psb_rcv(ictxt,& if (nesd>0) call psb_rcv(ctxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
if (nerv>0) call psb_snd(ictxt,& if (nerv>0) call psb_snd(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
else if (proc_to_comm == me) then else if (proc_to_comm == me) then
if (nesd /= nerv) then if (nesd /= nerv) then
@ -860,7 +860,7 @@ subroutine psi_ctranidxv(iictxt,iicomm,flag,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
p2ptag = psb_complex_swap_tag p2ptag = psb_complex_swap_tag
call mpi_irecv(sndbuf(snd_pt),nesd,& call mpi_irecv(sndbuf(snd_pt),nesd,&
@ -943,7 +943,7 @@ subroutine psi_ctranidxv(iictxt,iicomm,flag,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nerv>0) call psb_snd(ictxt,& if (nerv>0) call psb_snd(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd snd_pt = snd_pt + nesd
@ -959,7 +959,7 @@ subroutine psi_ctranidxv(iictxt,iicomm,flag,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nesd>0) call psb_rcv(ictxt,& if (nesd>0) call psb_rcv(ctxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd snd_pt = snd_pt + nesd
@ -1006,7 +1006,7 @@ subroutine psi_ctranidxv(iictxt,iicomm,flag,beta,y,idx,&
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_ctranidxv end subroutine psi_ctranidxv

16
base/comm/internals/psi_dovrl_restr.f90
Unescape Escape View File

@ -47,7 +47,7 @@ subroutine psi_dovrl_restr_vect(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz integer(psb_ipk_) :: np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -57,8 +57,8 @@ subroutine psi_dovrl_restr_vect(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -72,7 +72,7 @@ subroutine psi_dovrl_restr_vect(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_dovrl_restr_vect end subroutine psi_dovrl_restr_vect
@ -90,7 +90,7 @@ subroutine psi_dovrl_restr_multivect(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -100,8 +100,8 @@ subroutine psi_dovrl_restr_multivect(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -114,7 +114,7 @@ subroutine psi_dovrl_restr_multivect(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_dovrl_restr_multivect end subroutine psi_dovrl_restr_multivect

16
base/comm/internals/psi_dovrl_restr_a.f90
Unescape Escape View File

@ -45,7 +45,7 @@ subroutine psi_dovrl_restrr1(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz integer(psb_ipk_) :: np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -55,8 +55,8 @@ subroutine psi_dovrl_restrr1(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -73,7 +73,7 @@ subroutine psi_dovrl_restrr1(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_dovrl_restrr1 end subroutine psi_dovrl_restrr1
@ -89,7 +89,7 @@ subroutine psi_dovrl_restrr2(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz integer(psb_ipk_) :: np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -99,8 +99,8 @@ subroutine psi_dovrl_restrr2(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -124,7 +124,7 @@ subroutine psi_dovrl_restrr2(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_dovrl_restrr2 end subroutine psi_dovrl_restrr2

16
base/comm/internals/psi_dovrl_save.f90
Unescape Escape View File

@ -47,7 +47,7 @@ subroutine psi_dovrl_save_vect(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz integer(psb_ipk_) :: np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -57,8 +57,8 @@ subroutine psi_dovrl_save_vect(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -78,7 +78,7 @@ subroutine psi_dovrl_save_vect(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_dovrl_save_vect end subroutine psi_dovrl_save_vect
@ -96,7 +96,7 @@ subroutine psi_dovrl_save_multivect(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -106,8 +106,8 @@ subroutine psi_dovrl_save_multivect(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -128,7 +128,7 @@ subroutine psi_dovrl_save_multivect(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_dovrl_save_multivect end subroutine psi_dovrl_save_multivect

16
base/comm/internals/psi_dovrl_save_a.f90
Unescape Escape View File

@ -47,7 +47,7 @@ subroutine psi_dovrl_saver1(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz integer(psb_ipk_) :: np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -57,8 +57,8 @@ subroutine psi_dovrl_saver1(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -81,7 +81,7 @@ subroutine psi_dovrl_saver1(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_dovrl_saver1 end subroutine psi_dovrl_saver1
@ -100,7 +100,7 @@ subroutine psi_dovrl_saver2(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -110,8 +110,8 @@ subroutine psi_dovrl_saver2(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -135,7 +135,7 @@ subroutine psi_dovrl_saver2(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_dovrl_saver2 end subroutine psi_dovrl_saver2

16
base/comm/internals/psi_dovrl_upd.f90
Unescape Escape View File

@ -50,7 +50,7 @@ subroutine psi_dovrl_upd_vect(x,desc_a,update,info)
! locals ! locals
real(psb_dpk_), allocatable :: xs(:) real(psb_dpk_), allocatable :: xs(:)
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -62,8 +62,8 @@ subroutine psi_dovrl_upd_vect(x,desc_a,update,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -113,7 +113,7 @@ subroutine psi_dovrl_upd_vect(x,desc_a,update,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_dovrl_upd_vect end subroutine psi_dovrl_upd_vect
@ -132,7 +132,7 @@ subroutine psi_dovrl_upd_multivect(x,desc_a,update,info)
! locals ! locals
real(psb_dpk_), allocatable :: xs(:,:) real(psb_dpk_), allocatable :: xs(:,:)
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx, nc integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx, nc
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -144,8 +144,8 @@ subroutine psi_dovrl_upd_multivect(x,desc_a,update,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -196,7 +196,7 @@ subroutine psi_dovrl_upd_multivect(x,desc_a,update,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_dovrl_upd_multivect end subroutine psi_dovrl_upd_multivect

16
base/comm/internals/psi_dovrl_upd_a.f90
Unescape Escape View File

@ -46,7 +46,7 @@ subroutine psi_dovrl_updr1(x,desc_a,update,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, ndm integer(psb_ipk_) :: np, me, err_act, i, idx, ndm
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -57,8 +57,8 @@ subroutine psi_dovrl_updr1(x,desc_a,update,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -99,7 +99,7 @@ subroutine psi_dovrl_updr1(x,desc_a,update,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_dovrl_updr1 end subroutine psi_dovrl_updr1
@ -115,7 +115,7 @@ subroutine psi_dovrl_updr2(x,desc_a,update,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, ndm integer(psb_ipk_) :: np, me, err_act, i, idx, ndm
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -126,8 +126,8 @@ subroutine psi_dovrl_updr2(x,desc_a,update,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -168,7 +168,7 @@ subroutine psi_dovrl_updr2(x,desc_a,update,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_dovrl_updr2 end subroutine psi_dovrl_updr2

48
base/comm/internals/psi_dswapdata.F90
Unescape Escape View File

@ -113,7 +113,7 @@ subroutine psi_dswapdata_vect(flag,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act
class(psb_i_base_vect_type), pointer :: d_vidx class(psb_i_base_vect_type), pointer :: d_vidx
@ -123,9 +123,9 @@ subroutine psi_dswapdata_vect(flag,beta,y,desc_a,work,info,data)
name='psi_swap_datav' name='psi_swap_datav'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -150,13 +150,13 @@ subroutine psi_dswapdata_vect(flag,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swapdata(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) call psi_swapdata(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_dswapdata_vect end subroutine psi_dswapdata_vect
@ -175,7 +175,7 @@ end subroutine psi_dswapdata_vect
! !
! !
! !
subroutine psi_dswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & subroutine psi_dswap_vidx_vect(ictxt,iicomm,flag,beta,y,idx, &
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_dswap_vidx_vect use psi_mod, psb_protect_name => psi_dswap_vidx_vect
@ -192,7 +192,7 @@ subroutine psi_dswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: iictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: iicomm integer(psb_mpk_), intent(in) :: iicomm
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -203,7 +203,7 @@ subroutine psi_dswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm, np, me,& integer(psb_mpk_) :: icomm, np, me,&
& proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable :: prcid(:) integer(psb_mpk_), allocatable :: prcid(:)
@ -218,10 +218,10 @@ subroutine psi_dswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
info=psb_success_ info=psb_success_
name='psi_swap_datav' name='psi_swap_datav'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = iictxt ctxt = ictxt
icomm = iicomm icomm = iicomm
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -265,7 +265,7 @@ subroutine psi_dswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
nesd = idx%v(pnti+nerv+psb_n_elem_send_) nesd = idx%v(pnti+nerv+psb_n_elem_send_)
rcv_pt = 1+pnti+psb_n_elem_recv_ rcv_pt = 1+pnti+psb_n_elem_recv_
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt
p2ptag = psb_double_swap_tag p2ptag = psb_double_swap_tag
@ -418,7 +418,7 @@ subroutine psi_dswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_dswap_vidx_vect end subroutine psi_dswap_vidx_vect
@ -455,7 +455,7 @@ subroutine psi_dswapdata_multivect(flag,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act
class(psb_i_base_vect_type), pointer :: d_vidx class(psb_i_base_vect_type), pointer :: d_vidx
@ -465,9 +465,9 @@ subroutine psi_dswapdata_multivect(flag,beta,y,desc_a,work,info,data)
name='psi_swap_datav' name='psi_swap_datav'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -492,13 +492,13 @@ subroutine psi_dswapdata_multivect(flag,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swapdata(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) call psi_swapdata(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_dswapdata_multivect end subroutine psi_dswapdata_multivect
@ -517,7 +517,7 @@ end subroutine psi_dswapdata_multivect
! !
! !
! !
subroutine psi_dswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & subroutine psi_dswap_vidx_multivect(ictxt,iicomm,flag,beta,y,idx, &
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_dswap_vidx_multivect use psi_mod, psb_protect_name => psi_dswap_vidx_multivect
@ -534,7 +534,7 @@ subroutine psi_dswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: iictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: iicomm integer(psb_mpk_), intent(in) :: iicomm
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -545,7 +545,7 @@ subroutine psi_dswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm, np, me,& integer(psb_mpk_) :: icomm, np, me,&
& proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable :: prcid(:) integer(psb_mpk_), allocatable :: prcid(:)
@ -560,10 +560,10 @@ subroutine psi_dswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
info=psb_success_ info=psb_success_
name='psi_swap_datav' name='psi_swap_datav'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = iictxt ctxt = ictxt
icomm = iicomm icomm = iicomm
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -609,7 +609,7 @@ subroutine psi_dswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
proc_to_comm = idx%v(pnti+psb_proc_id_) proc_to_comm = idx%v(pnti+psb_proc_id_)
nerv = idx%v(pnti+psb_n_elem_recv_) nerv = idx%v(pnti+psb_n_elem_recv_)
nesd = idx%v(pnti+nerv+psb_n_elem_send_) nesd = idx%v(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt
p2ptag = psb_double_swap_tag p2ptag = psb_double_swap_tag
@ -766,7 +766,7 @@ subroutine psi_dswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_dswap_vidx_multivect end subroutine psi_dswap_vidx_multivect

72
base/comm/internals/psi_dswapdata_a.F90
Unescape Escape View File

@ -106,7 +106,7 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act
integer(psb_ipk_), pointer :: d_idx(:) integer(psb_ipk_), pointer :: d_idx(:)
@ -116,9 +116,9 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
name='psi_swap_data' name='psi_swap_data'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -143,18 +143,18 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swapdata(ictxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info) call psi_swapdata(ctxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_dswapdatam end subroutine psi_dswapdatam
subroutine psi_dswapidxm(ictxt,icomm,flag,n,beta,y,idx, & subroutine psi_dswapidxm(ctxt,icomm,flag,n,beta,y,idx, &
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_dswapidxm use psi_mod, psb_protect_name => psi_dswapidxm
@ -169,7 +169,7 @@ subroutine psi_dswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: icomm integer(psb_mpk_), intent(in) :: icomm
integer(psb_ipk_), intent(in) :: flag,n integer(psb_ipk_), intent(in) :: flag,n
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -198,7 +198,7 @@ subroutine psi_dswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
name='psi_swap_data' name='psi_swap_data'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -238,7 +238,7 @@ subroutine psi_dswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm)
brvidx(proc_to_comm) = rcv_pt brvidx(proc_to_comm) = rcv_pt
rvsz(proc_to_comm) = n*nerv rvsz(proc_to_comm) = n*nerv
@ -317,14 +317,14 @@ subroutine psi_dswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (proc_to_comm < me) then if (proc_to_comm < me) then
if (nesd>0) call psb_snd(ictxt,& if (nesd>0) call psb_snd(ctxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
if (nerv>0) call psb_rcv(ictxt,& if (nerv>0) call psb_rcv(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
else if (proc_to_comm > me) then else if (proc_to_comm > me) then
if (nerv>0) call psb_rcv(ictxt,& if (nerv>0) call psb_rcv(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
if (nesd>0) call psb_snd(ictxt,& if (nesd>0) call psb_snd(ctxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
else if (proc_to_comm == me) then else if (proc_to_comm == me) then
if (nesd /= nerv) then if (nesd /= nerv) then
@ -351,7 +351,7 @@ subroutine psi_dswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_double_swap_tag p2ptag = psb_double_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),n*nerv,& call mpi_irecv(rcvbuf(rcv_pt),n*nerv,&
@ -436,7 +436,7 @@ subroutine psi_dswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nesd>0) call psb_snd(ictxt,& if (nesd>0) call psb_snd(ctxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
rcv_pt = rcv_pt + n*nerv rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd snd_pt = snd_pt + n*nesd
@ -453,7 +453,7 @@ subroutine psi_dswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nerv>0) call psb_rcv(ictxt,& if (nerv>0) call psb_rcv(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
rcv_pt = rcv_pt + n*nerv rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd snd_pt = snd_pt + n*nesd
@ -501,7 +501,7 @@ subroutine psi_dswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_dswapidxm end subroutine psi_dswapidxm
@ -582,7 +582,7 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act
integer(psb_ipk_), pointer :: d_idx(:) integer(psb_ipk_), pointer :: d_idx(:)
@ -592,9 +592,9 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data)
name='psi_swap_datav' name='psi_swap_datav'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -619,13 +619,13 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swapdata(ictxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) call psi_swapdata(ctxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_dswapdatav end subroutine psi_dswapdatav
@ -641,7 +641,7 @@ end subroutine psi_dswapdatav
! !
! !
! !
subroutine psi_dswapidxv(iictxt,iicomm,flag,beta,y,idx, & subroutine psi_dswapidxv(ictxt,iicomm,flag,beta,y,idx, &
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_dswapidxv use psi_mod, psb_protect_name => psi_dswapidxv
@ -656,7 +656,7 @@ subroutine psi_dswapidxv(iictxt,iicomm,flag,beta,y,idx, &
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: iictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: iicomm integer(psb_mpk_), intent(in) :: iicomm
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -665,7 +665,7 @@ subroutine psi_dswapidxv(iictxt,iicomm,flag,beta,y,idx, &
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm, np, me,& integer(psb_mpk_) :: icomm, np, me,&
& proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
@ -684,10 +684,10 @@ subroutine psi_dswapidxv(iictxt,iicomm,flag,beta,y,idx, &
info=psb_success_ info=psb_success_
name='psi_swap_datav' name='psi_swap_datav'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = iictxt ctxt = ictxt
icomm = iicomm icomm = iicomm
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -727,7 +727,7 @@ subroutine psi_dswapidxv(iictxt,iicomm,flag,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm)
brvidx(proc_to_comm) = rcv_pt brvidx(proc_to_comm) = rcv_pt
rvsz(proc_to_comm) = nerv rvsz(proc_to_comm) = nerv
@ -807,14 +807,14 @@ subroutine psi_dswapidxv(iictxt,iicomm,flag,beta,y,idx, &
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (proc_to_comm < me) then if (proc_to_comm < me) then
if (nesd>0) call psb_snd(ictxt,& if (nesd>0) call psb_snd(ctxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
if (nerv>0) call psb_rcv(ictxt,& if (nerv>0) call psb_rcv(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
else if (proc_to_comm > me) then else if (proc_to_comm > me) then
if (nerv>0) call psb_rcv(ictxt,& if (nerv>0) call psb_rcv(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
if (nesd>0) call psb_snd(ictxt,& if (nesd>0) call psb_snd(ctxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
else if (proc_to_comm == me) then else if (proc_to_comm == me) then
if (nesd /= nerv) then if (nesd /= nerv) then
@ -841,7 +841,7 @@ subroutine psi_dswapidxv(iictxt,iicomm,flag,beta,y,idx, &
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_double_swap_tag p2ptag = psb_double_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),nerv,& call mpi_irecv(rcvbuf(rcv_pt),nerv,&
@ -925,7 +925,7 @@ subroutine psi_dswapidxv(iictxt,iicomm,flag,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nesd>0) call psb_snd(ictxt,& if (nesd>0) call psb_snd(ctxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd snd_pt = snd_pt + nesd
@ -941,7 +941,7 @@ subroutine psi_dswapidxv(iictxt,iicomm,flag,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nerv>0) call psb_rcv(ictxt,& if (nerv>0) call psb_rcv(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd snd_pt = snd_pt + nesd
@ -988,7 +988,7 @@ subroutine psi_dswapidxv(iictxt,iicomm,flag,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_dswapidxv end subroutine psi_dswapidxv

48
base/comm/internals/psi_dswaptran.F90
Unescape Escape View File

@ -115,7 +115,7 @@ subroutine psi_dswaptran_vect(flag,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_
class(psb_i_base_vect_type), pointer :: d_vidx class(psb_i_base_vect_type), pointer :: d_vidx
@ -125,9 +125,9 @@ subroutine psi_dswaptran_vect(flag,beta,y,desc_a,work,info,data)
name='psi_swap_tranv' name='psi_swap_tranv'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -152,13 +152,13 @@ subroutine psi_dswaptran_vect(flag,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swaptran(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) call psi_swaptran(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_dswaptran_vect end subroutine psi_dswaptran_vect
@ -176,7 +176,7 @@ end subroutine psi_dswaptran_vect
! !
! !
! !
subroutine psi_dtran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& subroutine psi_dtran_vidx_vect(ictxt,iicomm,flag,beta,y,idx,&
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_dtran_vidx_vect use psi_mod, psb_protect_name => psi_dtran_vidx_vect
@ -193,7 +193,7 @@ subroutine psi_dtran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: iictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: iicomm integer(psb_mpk_), intent(in) :: iicomm
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -204,7 +204,7 @@ subroutine psi_dtran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm, np, me,& integer(psb_mpk_) :: icomm, np, me,&
& proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable :: prcid(:) integer(psb_mpk_), allocatable :: prcid(:)
@ -219,10 +219,10 @@ subroutine psi_dtran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
info=psb_success_ info=psb_success_
name='psi_swap_tran' name='psi_swap_tran'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = iictxt ctxt = ictxt
icomm = iicomm icomm = iicomm
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -269,7 +269,7 @@ subroutine psi_dtran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
snd_pt = 1+pnti+nerv+psb_n_elem_send_ snd_pt = 1+pnti+nerv+psb_n_elem_send_
rcv_pt = 1+pnti+psb_n_elem_recv_ rcv_pt = 1+pnti+psb_n_elem_recv_
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt
call mpi_irecv(y%combuf(snd_pt),nesd,& call mpi_irecv(y%combuf(snd_pt),nesd,&
@ -425,7 +425,7 @@ subroutine psi_dtran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
@ -466,7 +466,7 @@ subroutine psi_dswaptran_multivect(flag,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_
class(psb_i_base_vect_type), pointer :: d_vidx class(psb_i_base_vect_type), pointer :: d_vidx
@ -476,9 +476,9 @@ subroutine psi_dswaptran_multivect(flag,beta,y,desc_a,work,info,data)
name='psi_swap_tranv' name='psi_swap_tranv'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -503,13 +503,13 @@ subroutine psi_dswaptran_multivect(flag,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swaptran(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) call psi_swaptran(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_dswaptran_multivect end subroutine psi_dswaptran_multivect
@ -528,7 +528,7 @@ subroutine psi_dswaptran_multivect(flag,beta,y,desc_a,work,info,data)
! !
! !
! !
subroutine psi_dtran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& subroutine psi_dtran_vidx_multivect(ictxt,iicomm,flag,beta,y,idx,&
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_dtran_vidx_multivect use psi_mod, psb_protect_name => psi_dtran_vidx_multivect
@ -545,7 +545,7 @@ subroutine psi_dtran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: iictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: iicomm integer(psb_mpk_), intent(in) :: iicomm
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -556,7 +556,7 @@ subroutine psi_dtran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm, np, me,& integer(psb_mpk_) :: icomm, np, me,&
& proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable :: prcid(:) integer(psb_mpk_), allocatable :: prcid(:)
@ -571,10 +571,10 @@ subroutine psi_dtran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
info=psb_success_ info=psb_success_
name='psi_swap_tran' name='psi_swap_tran'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = iictxt ctxt = ictxt
icomm = iicomm icomm = iicomm
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -621,7 +621,7 @@ subroutine psi_dtran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
proc_to_comm = idx%v(pnti+psb_proc_id_) proc_to_comm = idx%v(pnti+psb_proc_id_)
nerv = idx%v(pnti+psb_n_elem_recv_) nerv = idx%v(pnti+psb_n_elem_recv_)
nesd = idx%v(pnti+nerv+psb_n_elem_send_) nesd = idx%v(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
if (debug) write(*,*) me,'Posting receive from',prcid(i),snd_pt if (debug) write(*,*) me,'Posting receive from',prcid(i),snd_pt
call mpi_irecv(y%combuf(snd_pt),n*nesd,& call mpi_irecv(y%combuf(snd_pt),n*nesd,&
@ -781,7 +781,7 @@ subroutine psi_dtran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return

76
base/comm/internals/psi_dswaptran_a.F90
Unescape Escape View File

@ -110,7 +110,7 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, err_act, totxch, data_ integer(psb_ipk_) :: np, me, idxs, idxr, err_act, totxch, data_
integer(psb_ipk_), pointer :: d_idx(:) integer(psb_ipk_), pointer :: d_idx(:)
@ -120,10 +120,10 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
name='psi_swap_tran' name='psi_swap_tran'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -148,18 +148,18 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swaptran(ictxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info) call psi_swaptran(ctxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_dswaptranm end subroutine psi_dswaptranm
subroutine psi_dtranidxm(iictxt,iicomm,flag,n,beta,y,idx,& subroutine psi_dtranidxm(ictxt,iicomm,flag,n,beta,y,idx,&
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_dtranidxm use psi_mod, psb_protect_name => psi_dtranidxm
@ -174,7 +174,7 @@ subroutine psi_dtranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: iictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: iicomm integer(psb_mpk_), intent(in) :: iicomm
integer(psb_ipk_), intent(in) :: flag,n integer(psb_ipk_), intent(in) :: flag,n
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -183,7 +183,7 @@ subroutine psi_dtranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm, np, me,& integer(psb_mpk_) :: icomm, np, me,&
& proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
@ -202,10 +202,10 @@ subroutine psi_dtranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
info=psb_success_ info=psb_success_
name='psi_swap_tran' name='psi_swap_tran'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = iictxt ctxt = ictxt
icomm = iicomm icomm = iicomm
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -245,7 +245,7 @@ subroutine psi_dtranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm)
brvidx(proc_to_comm) = rcv_pt brvidx(proc_to_comm) = rcv_pt
rvsz(proc_to_comm) = n*nerv rvsz(proc_to_comm) = n*nerv
@ -329,14 +329,14 @@ subroutine psi_dtranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (proc_to_comm < me) then if (proc_to_comm < me) then
if (nerv>0) call psb_snd(ictxt,& if (nerv>0) call psb_snd(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
if (nesd>0) call psb_rcv(ictxt,& if (nesd>0) call psb_rcv(ctxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
else if (proc_to_comm > me) then else if (proc_to_comm > me) then
if (nesd>0) call psb_rcv(ictxt,& if (nesd>0) call psb_rcv(ctxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
if (nerv>0) call psb_snd(ictxt,& if (nerv>0) call psb_snd(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
else if (proc_to_comm == me) then else if (proc_to_comm == me) then
if (nesd /= nerv) then if (nesd /= nerv) then
@ -363,7 +363,7 @@ subroutine psi_dtranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
p2ptag = psb_double_swap_tag p2ptag = psb_double_swap_tag
call mpi_irecv(sndbuf(snd_pt),n*nesd,& call mpi_irecv(sndbuf(snd_pt),n*nesd,&
@ -448,7 +448,7 @@ subroutine psi_dtranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nerv>0) call psb_snd(ictxt,& if (nerv>0) call psb_snd(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
rcv_pt = rcv_pt + n*nerv rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd snd_pt = snd_pt + n*nesd
@ -465,7 +465,7 @@ subroutine psi_dtranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nesd>0) call psb_rcv(ictxt,& if (nesd>0) call psb_rcv(ctxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
rcv_pt = rcv_pt + n*nerv rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd snd_pt = snd_pt + n*nesd
@ -513,7 +513,7 @@ subroutine psi_dtranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_dtranidxm end subroutine psi_dtranidxm
@ -597,7 +597,7 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_
integer(psb_ipk_), pointer :: d_idx(:) integer(psb_ipk_), pointer :: d_idx(:)
@ -607,9 +607,9 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
name='psi_swap_tranv' name='psi_swap_tranv'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -634,13 +634,13 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swaptran(ictxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) call psi_swaptran(ctxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_dswaptranv end subroutine psi_dswaptranv
@ -656,7 +656,7 @@ end subroutine psi_dswaptranv
! !
! !
! !
subroutine psi_dtranidxv(iictxt,iicomm,flag,beta,y,idx,& subroutine psi_dtranidxv(ictxt,iicomm,flag,beta,y,idx,&
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_dtranidxv use psi_mod, psb_protect_name => psi_dtranidxv
@ -671,7 +671,7 @@ subroutine psi_dtranidxv(iictxt,iicomm,flag,beta,y,idx,&
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: iictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: iicomm integer(psb_mpk_), intent(in) :: iicomm
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -680,7 +680,7 @@ subroutine psi_dtranidxv(iictxt,iicomm,flag,beta,y,idx,&
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm, np, me,& integer(psb_mpk_) :: icomm, np, me,&
& proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
@ -699,10 +699,10 @@ subroutine psi_dtranidxv(iictxt,iicomm,flag,beta,y,idx,&
info=psb_success_ info=psb_success_
name='psi_swap_tran' name='psi_swap_tran'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = iictxt ctxt = ictxt
icomm = iicomm icomm = iicomm
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -742,7 +742,7 @@ subroutine psi_dtranidxv(iictxt,iicomm,flag,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm)
brvidx(proc_to_comm) = rcv_pt brvidx(proc_to_comm) = rcv_pt
rvsz(proc_to_comm) = nerv rvsz(proc_to_comm) = nerv
@ -827,14 +827,14 @@ subroutine psi_dtranidxv(iictxt,iicomm,flag,beta,y,idx,&
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (proc_to_comm < me) then if (proc_to_comm < me) then
if (nerv>0) call psb_snd(ictxt,& if (nerv>0) call psb_snd(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
if (nesd>0) call psb_rcv(ictxt,& if (nesd>0) call psb_rcv(ctxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
else if (proc_to_comm > me) then else if (proc_to_comm > me) then
if (nesd>0) call psb_rcv(ictxt,& if (nesd>0) call psb_rcv(ctxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
if (nerv>0) call psb_snd(ictxt,& if (nerv>0) call psb_snd(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
else if (proc_to_comm == me) then else if (proc_to_comm == me) then
if (nesd /= nerv) then if (nesd /= nerv) then
@ -860,7 +860,7 @@ subroutine psi_dtranidxv(iictxt,iicomm,flag,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
p2ptag = psb_double_swap_tag p2ptag = psb_double_swap_tag
call mpi_irecv(sndbuf(snd_pt),nesd,& call mpi_irecv(sndbuf(snd_pt),nesd,&
@ -943,7 +943,7 @@ subroutine psi_dtranidxv(iictxt,iicomm,flag,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nerv>0) call psb_snd(ictxt,& if (nerv>0) call psb_snd(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd snd_pt = snd_pt + nesd
@ -959,7 +959,7 @@ subroutine psi_dtranidxv(iictxt,iicomm,flag,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nesd>0) call psb_rcv(ictxt,& if (nesd>0) call psb_rcv(ctxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd snd_pt = snd_pt + nesd
@ -1006,7 +1006,7 @@ subroutine psi_dtranidxv(iictxt,iicomm,flag,beta,y,idx,&
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_dtranidxv end subroutine psi_dtranidxv

16
base/comm/internals/psi_eovrl_restr_a.f90
Unescape Escape View File

@ -45,7 +45,7 @@ subroutine psi_eovrl_restrr1(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz integer(psb_ipk_) :: np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -55,8 +55,8 @@ subroutine psi_eovrl_restrr1(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -73,7 +73,7 @@ subroutine psi_eovrl_restrr1(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_eovrl_restrr1 end subroutine psi_eovrl_restrr1
@ -89,7 +89,7 @@ subroutine psi_eovrl_restrr2(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz integer(psb_ipk_) :: np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -99,8 +99,8 @@ subroutine psi_eovrl_restrr2(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -124,7 +124,7 @@ subroutine psi_eovrl_restrr2(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_eovrl_restrr2 end subroutine psi_eovrl_restrr2

16
base/comm/internals/psi_eovrl_save_a.f90
Unescape Escape View File

@ -47,7 +47,7 @@ subroutine psi_eovrl_saver1(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz integer(psb_ipk_) :: np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -57,8 +57,8 @@ subroutine psi_eovrl_saver1(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -81,7 +81,7 @@ subroutine psi_eovrl_saver1(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_eovrl_saver1 end subroutine psi_eovrl_saver1
@ -100,7 +100,7 @@ subroutine psi_eovrl_saver2(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -110,8 +110,8 @@ subroutine psi_eovrl_saver2(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -135,7 +135,7 @@ subroutine psi_eovrl_saver2(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_eovrl_saver2 end subroutine psi_eovrl_saver2

16
base/comm/internals/psi_eovrl_upd_a.f90
Unescape Escape View File

@ -46,7 +46,7 @@ subroutine psi_eovrl_updr1(x,desc_a,update,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, ndm integer(psb_ipk_) :: np, me, err_act, i, idx, ndm
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -57,8 +57,8 @@ subroutine psi_eovrl_updr1(x,desc_a,update,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -99,7 +99,7 @@ subroutine psi_eovrl_updr1(x,desc_a,update,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_eovrl_updr1 end subroutine psi_eovrl_updr1
@ -115,7 +115,7 @@ subroutine psi_eovrl_updr2(x,desc_a,update,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, ndm integer(psb_ipk_) :: np, me, err_act, i, idx, ndm
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -126,8 +126,8 @@ subroutine psi_eovrl_updr2(x,desc_a,update,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -168,7 +168,7 @@ subroutine psi_eovrl_updr2(x,desc_a,update,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_eovrl_updr2 end subroutine psi_eovrl_updr2

72
base/comm/internals/psi_eswapdata_a.F90
Unescape Escape View File

@ -106,7 +106,7 @@ subroutine psi_eswapdatam(flag,n,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act
integer(psb_ipk_), pointer :: d_idx(:) integer(psb_ipk_), pointer :: d_idx(:)
@ -116,9 +116,9 @@ subroutine psi_eswapdatam(flag,n,beta,y,desc_a,work,info,data)
name='psi_swap_data' name='psi_swap_data'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -143,18 +143,18 @@ subroutine psi_eswapdatam(flag,n,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swapdata(ictxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info) call psi_swapdata(ctxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_eswapdatam end subroutine psi_eswapdatam
subroutine psi_eswapidxm(ictxt,icomm,flag,n,beta,y,idx, & subroutine psi_eswapidxm(ctxt,icomm,flag,n,beta,y,idx, &
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_eswapidxm use psi_mod, psb_protect_name => psi_eswapidxm
@ -169,7 +169,7 @@ subroutine psi_eswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: icomm integer(psb_mpk_), intent(in) :: icomm
integer(psb_ipk_), intent(in) :: flag,n integer(psb_ipk_), intent(in) :: flag,n
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -198,7 +198,7 @@ subroutine psi_eswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
name='psi_swap_data' name='psi_swap_data'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -238,7 +238,7 @@ subroutine psi_eswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm)
brvidx(proc_to_comm) = rcv_pt brvidx(proc_to_comm) = rcv_pt
rvsz(proc_to_comm) = n*nerv rvsz(proc_to_comm) = n*nerv
@ -317,14 +317,14 @@ subroutine psi_eswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (proc_to_comm < me) then if (proc_to_comm < me) then
if (nesd>0) call psb_snd(ictxt,& if (nesd>0) call psb_snd(ctxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
if (nerv>0) call psb_rcv(ictxt,& if (nerv>0) call psb_rcv(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
else if (proc_to_comm > me) then else if (proc_to_comm > me) then
if (nerv>0) call psb_rcv(ictxt,& if (nerv>0) call psb_rcv(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
if (nesd>0) call psb_snd(ictxt,& if (nesd>0) call psb_snd(ctxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
else if (proc_to_comm == me) then else if (proc_to_comm == me) then
if (nesd /= nerv) then if (nesd /= nerv) then
@ -351,7 +351,7 @@ subroutine psi_eswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_int8_swap_tag p2ptag = psb_int8_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),n*nerv,& call mpi_irecv(rcvbuf(rcv_pt),n*nerv,&
@ -436,7 +436,7 @@ subroutine psi_eswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nesd>0) call psb_snd(ictxt,& if (nesd>0) call psb_snd(ctxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
rcv_pt = rcv_pt + n*nerv rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd snd_pt = snd_pt + n*nesd
@ -453,7 +453,7 @@ subroutine psi_eswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nerv>0) call psb_rcv(ictxt,& if (nerv>0) call psb_rcv(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
rcv_pt = rcv_pt + n*nerv rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd snd_pt = snd_pt + n*nesd
@ -501,7 +501,7 @@ subroutine psi_eswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_eswapidxm end subroutine psi_eswapidxm
@ -582,7 +582,7 @@ subroutine psi_eswapdatav(flag,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act
integer(psb_ipk_), pointer :: d_idx(:) integer(psb_ipk_), pointer :: d_idx(:)
@ -592,9 +592,9 @@ subroutine psi_eswapdatav(flag,beta,y,desc_a,work,info,data)
name='psi_swap_datav' name='psi_swap_datav'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -619,13 +619,13 @@ subroutine psi_eswapdatav(flag,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swapdata(ictxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) call psi_swapdata(ctxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_eswapdatav end subroutine psi_eswapdatav
@ -641,7 +641,7 @@ end subroutine psi_eswapdatav
! !
! !
! !
subroutine psi_eswapidxv(iictxt,iicomm,flag,beta,y,idx, & subroutine psi_eswapidxv(ictxt,iicomm,flag,beta,y,idx, &
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_eswapidxv use psi_mod, psb_protect_name => psi_eswapidxv
@ -656,7 +656,7 @@ subroutine psi_eswapidxv(iictxt,iicomm,flag,beta,y,idx, &
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: iictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: iicomm integer(psb_mpk_), intent(in) :: iicomm
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -665,7 +665,7 @@ subroutine psi_eswapidxv(iictxt,iicomm,flag,beta,y,idx, &
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm, np, me,& integer(psb_mpk_) :: icomm, np, me,&
& proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
@ -684,10 +684,10 @@ subroutine psi_eswapidxv(iictxt,iicomm,flag,beta,y,idx, &
info=psb_success_ info=psb_success_
name='psi_swap_datav' name='psi_swap_datav'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = iictxt ctxt = ictxt
icomm = iicomm icomm = iicomm
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -727,7 +727,7 @@ subroutine psi_eswapidxv(iictxt,iicomm,flag,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm)
brvidx(proc_to_comm) = rcv_pt brvidx(proc_to_comm) = rcv_pt
rvsz(proc_to_comm) = nerv rvsz(proc_to_comm) = nerv
@ -807,14 +807,14 @@ subroutine psi_eswapidxv(iictxt,iicomm,flag,beta,y,idx, &
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (proc_to_comm < me) then if (proc_to_comm < me) then
if (nesd>0) call psb_snd(ictxt,& if (nesd>0) call psb_snd(ctxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
if (nerv>0) call psb_rcv(ictxt,& if (nerv>0) call psb_rcv(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
else if (proc_to_comm > me) then else if (proc_to_comm > me) then
if (nerv>0) call psb_rcv(ictxt,& if (nerv>0) call psb_rcv(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
if (nesd>0) call psb_snd(ictxt,& if (nesd>0) call psb_snd(ctxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
else if (proc_to_comm == me) then else if (proc_to_comm == me) then
if (nesd /= nerv) then if (nesd /= nerv) then
@ -841,7 +841,7 @@ subroutine psi_eswapidxv(iictxt,iicomm,flag,beta,y,idx, &
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_int8_swap_tag p2ptag = psb_int8_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),nerv,& call mpi_irecv(rcvbuf(rcv_pt),nerv,&
@ -925,7 +925,7 @@ subroutine psi_eswapidxv(iictxt,iicomm,flag,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nesd>0) call psb_snd(ictxt,& if (nesd>0) call psb_snd(ctxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd snd_pt = snd_pt + nesd
@ -941,7 +941,7 @@ subroutine psi_eswapidxv(iictxt,iicomm,flag,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nerv>0) call psb_rcv(ictxt,& if (nerv>0) call psb_rcv(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd snd_pt = snd_pt + nesd
@ -988,7 +988,7 @@ subroutine psi_eswapidxv(iictxt,iicomm,flag,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_eswapidxv end subroutine psi_eswapidxv

76
base/comm/internals/psi_eswaptran_a.F90
Unescape Escape View File

@ -110,7 +110,7 @@ subroutine psi_eswaptranm(flag,n,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, err_act, totxch, data_ integer(psb_ipk_) :: np, me, idxs, idxr, err_act, totxch, data_
integer(psb_ipk_), pointer :: d_idx(:) integer(psb_ipk_), pointer :: d_idx(:)
@ -120,10 +120,10 @@ subroutine psi_eswaptranm(flag,n,beta,y,desc_a,work,info,data)
name='psi_swap_tran' name='psi_swap_tran'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -148,18 +148,18 @@ subroutine psi_eswaptranm(flag,n,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swaptran(ictxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info) call psi_swaptran(ctxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_eswaptranm end subroutine psi_eswaptranm
subroutine psi_etranidxm(iictxt,iicomm,flag,n,beta,y,idx,& subroutine psi_etranidxm(ictxt,iicomm,flag,n,beta,y,idx,&
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_etranidxm use psi_mod, psb_protect_name => psi_etranidxm
@ -174,7 +174,7 @@ subroutine psi_etranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: iictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: iicomm integer(psb_mpk_), intent(in) :: iicomm
integer(psb_ipk_), intent(in) :: flag,n integer(psb_ipk_), intent(in) :: flag,n
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -183,7 +183,7 @@ subroutine psi_etranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm, np, me,& integer(psb_mpk_) :: icomm, np, me,&
& proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
@ -202,10 +202,10 @@ subroutine psi_etranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
info=psb_success_ info=psb_success_
name='psi_swap_tran' name='psi_swap_tran'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = iictxt ctxt = ictxt
icomm = iicomm icomm = iicomm
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -245,7 +245,7 @@ subroutine psi_etranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm)
brvidx(proc_to_comm) = rcv_pt brvidx(proc_to_comm) = rcv_pt
rvsz(proc_to_comm) = n*nerv rvsz(proc_to_comm) = n*nerv
@ -329,14 +329,14 @@ subroutine psi_etranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (proc_to_comm < me) then if (proc_to_comm < me) then
if (nerv>0) call psb_snd(ictxt,& if (nerv>0) call psb_snd(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
if (nesd>0) call psb_rcv(ictxt,& if (nesd>0) call psb_rcv(ctxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
else if (proc_to_comm > me) then else if (proc_to_comm > me) then
if (nesd>0) call psb_rcv(ictxt,& if (nesd>0) call psb_rcv(ctxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
if (nerv>0) call psb_snd(ictxt,& if (nerv>0) call psb_snd(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
else if (proc_to_comm == me) then else if (proc_to_comm == me) then
if (nesd /= nerv) then if (nesd /= nerv) then
@ -363,7 +363,7 @@ subroutine psi_etranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
p2ptag = psb_int8_swap_tag p2ptag = psb_int8_swap_tag
call mpi_irecv(sndbuf(snd_pt),n*nesd,& call mpi_irecv(sndbuf(snd_pt),n*nesd,&
@ -448,7 +448,7 @@ subroutine psi_etranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nerv>0) call psb_snd(ictxt,& if (nerv>0) call psb_snd(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
rcv_pt = rcv_pt + n*nerv rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd snd_pt = snd_pt + n*nesd
@ -465,7 +465,7 @@ subroutine psi_etranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nesd>0) call psb_rcv(ictxt,& if (nesd>0) call psb_rcv(ctxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
rcv_pt = rcv_pt + n*nerv rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd snd_pt = snd_pt + n*nesd
@ -513,7 +513,7 @@ subroutine psi_etranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_etranidxm end subroutine psi_etranidxm
@ -597,7 +597,7 @@ subroutine psi_eswaptranv(flag,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_
integer(psb_ipk_), pointer :: d_idx(:) integer(psb_ipk_), pointer :: d_idx(:)
@ -607,9 +607,9 @@ subroutine psi_eswaptranv(flag,beta,y,desc_a,work,info,data)
name='psi_swap_tranv' name='psi_swap_tranv'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -634,13 +634,13 @@ subroutine psi_eswaptranv(flag,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swaptran(ictxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) call psi_swaptran(ctxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_eswaptranv end subroutine psi_eswaptranv
@ -656,7 +656,7 @@ end subroutine psi_eswaptranv
! !
! !
! !
subroutine psi_etranidxv(iictxt,iicomm,flag,beta,y,idx,& subroutine psi_etranidxv(ictxt,iicomm,flag,beta,y,idx,&
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_etranidxv use psi_mod, psb_protect_name => psi_etranidxv
@ -671,7 +671,7 @@ subroutine psi_etranidxv(iictxt,iicomm,flag,beta,y,idx,&
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: iictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: iicomm integer(psb_mpk_), intent(in) :: iicomm
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -680,7 +680,7 @@ subroutine psi_etranidxv(iictxt,iicomm,flag,beta,y,idx,&
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm, np, me,& integer(psb_mpk_) :: icomm, np, me,&
& proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
@ -699,10 +699,10 @@ subroutine psi_etranidxv(iictxt,iicomm,flag,beta,y,idx,&
info=psb_success_ info=psb_success_
name='psi_swap_tran' name='psi_swap_tran'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = iictxt ctxt = ictxt
icomm = iicomm icomm = iicomm
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -742,7 +742,7 @@ subroutine psi_etranidxv(iictxt,iicomm,flag,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm)
brvidx(proc_to_comm) = rcv_pt brvidx(proc_to_comm) = rcv_pt
rvsz(proc_to_comm) = nerv rvsz(proc_to_comm) = nerv
@ -827,14 +827,14 @@ subroutine psi_etranidxv(iictxt,iicomm,flag,beta,y,idx,&
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (proc_to_comm < me) then if (proc_to_comm < me) then
if (nerv>0) call psb_snd(ictxt,& if (nerv>0) call psb_snd(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
if (nesd>0) call psb_rcv(ictxt,& if (nesd>0) call psb_rcv(ctxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
else if (proc_to_comm > me) then else if (proc_to_comm > me) then
if (nesd>0) call psb_rcv(ictxt,& if (nesd>0) call psb_rcv(ctxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
if (nerv>0) call psb_snd(ictxt,& if (nerv>0) call psb_snd(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
else if (proc_to_comm == me) then else if (proc_to_comm == me) then
if (nesd /= nerv) then if (nesd /= nerv) then
@ -860,7 +860,7 @@ subroutine psi_etranidxv(iictxt,iicomm,flag,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
p2ptag = psb_int8_swap_tag p2ptag = psb_int8_swap_tag
call mpi_irecv(sndbuf(snd_pt),nesd,& call mpi_irecv(sndbuf(snd_pt),nesd,&
@ -943,7 +943,7 @@ subroutine psi_etranidxv(iictxt,iicomm,flag,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nerv>0) call psb_snd(ictxt,& if (nerv>0) call psb_snd(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd snd_pt = snd_pt + nesd
@ -959,7 +959,7 @@ subroutine psi_etranidxv(iictxt,iicomm,flag,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nesd>0) call psb_rcv(ictxt,& if (nesd>0) call psb_rcv(ctxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd snd_pt = snd_pt + nesd
@ -1006,7 +1006,7 @@ subroutine psi_etranidxv(iictxt,iicomm,flag,beta,y,idx,&
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_etranidxv end subroutine psi_etranidxv

16
base/comm/internals/psi_i2ovrl_restr_a.f90
Unescape Escape View File

@ -45,7 +45,7 @@ subroutine psi_i2ovrl_restrr1(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz integer(psb_ipk_) :: np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -55,8 +55,8 @@ subroutine psi_i2ovrl_restrr1(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -73,7 +73,7 @@ subroutine psi_i2ovrl_restrr1(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_i2ovrl_restrr1 end subroutine psi_i2ovrl_restrr1
@ -89,7 +89,7 @@ subroutine psi_i2ovrl_restrr2(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz integer(psb_ipk_) :: np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -99,8 +99,8 @@ subroutine psi_i2ovrl_restrr2(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -124,7 +124,7 @@ subroutine psi_i2ovrl_restrr2(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_i2ovrl_restrr2 end subroutine psi_i2ovrl_restrr2

16
base/comm/internals/psi_i2ovrl_save_a.f90
Unescape Escape View File

@ -47,7 +47,7 @@ subroutine psi_i2ovrl_saver1(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz integer(psb_ipk_) :: np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -57,8 +57,8 @@ subroutine psi_i2ovrl_saver1(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -81,7 +81,7 @@ subroutine psi_i2ovrl_saver1(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_i2ovrl_saver1 end subroutine psi_i2ovrl_saver1
@ -100,7 +100,7 @@ subroutine psi_i2ovrl_saver2(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -110,8 +110,8 @@ subroutine psi_i2ovrl_saver2(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -135,7 +135,7 @@ subroutine psi_i2ovrl_saver2(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_i2ovrl_saver2 end subroutine psi_i2ovrl_saver2

16
base/comm/internals/psi_i2ovrl_upd_a.f90
Unescape Escape View File

@ -46,7 +46,7 @@ subroutine psi_i2ovrl_updr1(x,desc_a,update,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, ndm integer(psb_ipk_) :: np, me, err_act, i, idx, ndm
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -57,8 +57,8 @@ subroutine psi_i2ovrl_updr1(x,desc_a,update,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -99,7 +99,7 @@ subroutine psi_i2ovrl_updr1(x,desc_a,update,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_i2ovrl_updr1 end subroutine psi_i2ovrl_updr1
@ -115,7 +115,7 @@ subroutine psi_i2ovrl_updr2(x,desc_a,update,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, ndm integer(psb_ipk_) :: np, me, err_act, i, idx, ndm
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -126,8 +126,8 @@ subroutine psi_i2ovrl_updr2(x,desc_a,update,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -168,7 +168,7 @@ subroutine psi_i2ovrl_updr2(x,desc_a,update,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_i2ovrl_updr2 end subroutine psi_i2ovrl_updr2

72
base/comm/internals/psi_i2swapdata_a.F90
Unescape Escape View File

@ -106,7 +106,7 @@ subroutine psi_i2swapdatam(flag,n,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act
integer(psb_ipk_), pointer :: d_idx(:) integer(psb_ipk_), pointer :: d_idx(:)
@ -116,9 +116,9 @@ subroutine psi_i2swapdatam(flag,n,beta,y,desc_a,work,info,data)
name='psi_swap_data' name='psi_swap_data'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -143,18 +143,18 @@ subroutine psi_i2swapdatam(flag,n,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swapdata(ictxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info) call psi_swapdata(ctxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_i2swapdatam end subroutine psi_i2swapdatam
subroutine psi_i2swapidxm(ictxt,icomm,flag,n,beta,y,idx, & subroutine psi_i2swapidxm(ctxt,icomm,flag,n,beta,y,idx, &
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_i2swapidxm use psi_mod, psb_protect_name => psi_i2swapidxm
@ -169,7 +169,7 @@ subroutine psi_i2swapidxm(ictxt,icomm,flag,n,beta,y,idx, &
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: icomm integer(psb_mpk_), intent(in) :: icomm
integer(psb_ipk_), intent(in) :: flag,n integer(psb_ipk_), intent(in) :: flag,n
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -198,7 +198,7 @@ subroutine psi_i2swapidxm(ictxt,icomm,flag,n,beta,y,idx, &
name='psi_swap_data' name='psi_swap_data'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -238,7 +238,7 @@ subroutine psi_i2swapidxm(ictxt,icomm,flag,n,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm)
brvidx(proc_to_comm) = rcv_pt brvidx(proc_to_comm) = rcv_pt
rvsz(proc_to_comm) = n*nerv rvsz(proc_to_comm) = n*nerv
@ -317,14 +317,14 @@ subroutine psi_i2swapidxm(ictxt,icomm,flag,n,beta,y,idx, &
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (proc_to_comm < me) then if (proc_to_comm < me) then
if (nesd>0) call psb_snd(ictxt,& if (nesd>0) call psb_snd(ctxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
if (nerv>0) call psb_rcv(ictxt,& if (nerv>0) call psb_rcv(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
else if (proc_to_comm > me) then else if (proc_to_comm > me) then
if (nerv>0) call psb_rcv(ictxt,& if (nerv>0) call psb_rcv(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
if (nesd>0) call psb_snd(ictxt,& if (nesd>0) call psb_snd(ctxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
else if (proc_to_comm == me) then else if (proc_to_comm == me) then
if (nesd /= nerv) then if (nesd /= nerv) then
@ -351,7 +351,7 @@ subroutine psi_i2swapidxm(ictxt,icomm,flag,n,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_int2_swap_tag p2ptag = psb_int2_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),n*nerv,& call mpi_irecv(rcvbuf(rcv_pt),n*nerv,&
@ -436,7 +436,7 @@ subroutine psi_i2swapidxm(ictxt,icomm,flag,n,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nesd>0) call psb_snd(ictxt,& if (nesd>0) call psb_snd(ctxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
rcv_pt = rcv_pt + n*nerv rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd snd_pt = snd_pt + n*nesd
@ -453,7 +453,7 @@ subroutine psi_i2swapidxm(ictxt,icomm,flag,n,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nerv>0) call psb_rcv(ictxt,& if (nerv>0) call psb_rcv(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
rcv_pt = rcv_pt + n*nerv rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd snd_pt = snd_pt + n*nesd
@ -501,7 +501,7 @@ subroutine psi_i2swapidxm(ictxt,icomm,flag,n,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_i2swapidxm end subroutine psi_i2swapidxm
@ -582,7 +582,7 @@ subroutine psi_i2swapdatav(flag,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act
integer(psb_ipk_), pointer :: d_idx(:) integer(psb_ipk_), pointer :: d_idx(:)
@ -592,9 +592,9 @@ subroutine psi_i2swapdatav(flag,beta,y,desc_a,work,info,data)
name='psi_swap_datav' name='psi_swap_datav'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -619,13 +619,13 @@ subroutine psi_i2swapdatav(flag,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swapdata(ictxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) call psi_swapdata(ctxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_i2swapdatav end subroutine psi_i2swapdatav
@ -641,7 +641,7 @@ end subroutine psi_i2swapdatav
! !
! !
! !
subroutine psi_i2swapidxv(iictxt,iicomm,flag,beta,y,idx, & subroutine psi_i2swapidxv(ictxt,iicomm,flag,beta,y,idx, &
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_i2swapidxv use psi_mod, psb_protect_name => psi_i2swapidxv
@ -656,7 +656,7 @@ subroutine psi_i2swapidxv(iictxt,iicomm,flag,beta,y,idx, &
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: iictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: iicomm integer(psb_mpk_), intent(in) :: iicomm
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -665,7 +665,7 @@ subroutine psi_i2swapidxv(iictxt,iicomm,flag,beta,y,idx, &
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm, np, me,& integer(psb_mpk_) :: icomm, np, me,&
& proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
@ -684,10 +684,10 @@ subroutine psi_i2swapidxv(iictxt,iicomm,flag,beta,y,idx, &
info=psb_success_ info=psb_success_
name='psi_swap_datav' name='psi_swap_datav'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = iictxt ctxt = ictxt
icomm = iicomm icomm = iicomm
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -727,7 +727,7 @@ subroutine psi_i2swapidxv(iictxt,iicomm,flag,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm)
brvidx(proc_to_comm) = rcv_pt brvidx(proc_to_comm) = rcv_pt
rvsz(proc_to_comm) = nerv rvsz(proc_to_comm) = nerv
@ -807,14 +807,14 @@ subroutine psi_i2swapidxv(iictxt,iicomm,flag,beta,y,idx, &
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (proc_to_comm < me) then if (proc_to_comm < me) then
if (nesd>0) call psb_snd(ictxt,& if (nesd>0) call psb_snd(ctxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
if (nerv>0) call psb_rcv(ictxt,& if (nerv>0) call psb_rcv(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
else if (proc_to_comm > me) then else if (proc_to_comm > me) then
if (nerv>0) call psb_rcv(ictxt,& if (nerv>0) call psb_rcv(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
if (nesd>0) call psb_snd(ictxt,& if (nesd>0) call psb_snd(ctxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
else if (proc_to_comm == me) then else if (proc_to_comm == me) then
if (nesd /= nerv) then if (nesd /= nerv) then
@ -841,7 +841,7 @@ subroutine psi_i2swapidxv(iictxt,iicomm,flag,beta,y,idx, &
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_int2_swap_tag p2ptag = psb_int2_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),nerv,& call mpi_irecv(rcvbuf(rcv_pt),nerv,&
@ -925,7 +925,7 @@ subroutine psi_i2swapidxv(iictxt,iicomm,flag,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nesd>0) call psb_snd(ictxt,& if (nesd>0) call psb_snd(ctxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd snd_pt = snd_pt + nesd
@ -941,7 +941,7 @@ subroutine psi_i2swapidxv(iictxt,iicomm,flag,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nerv>0) call psb_rcv(ictxt,& if (nerv>0) call psb_rcv(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd snd_pt = snd_pt + nesd
@ -988,7 +988,7 @@ subroutine psi_i2swapidxv(iictxt,iicomm,flag,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_i2swapidxv end subroutine psi_i2swapidxv

76
base/comm/internals/psi_i2swaptran_a.F90
Unescape Escape View File

@ -110,7 +110,7 @@ subroutine psi_i2swaptranm(flag,n,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, err_act, totxch, data_ integer(psb_ipk_) :: np, me, idxs, idxr, err_act, totxch, data_
integer(psb_ipk_), pointer :: d_idx(:) integer(psb_ipk_), pointer :: d_idx(:)
@ -120,10 +120,10 @@ subroutine psi_i2swaptranm(flag,n,beta,y,desc_a,work,info,data)
name='psi_swap_tran' name='psi_swap_tran'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -148,18 +148,18 @@ subroutine psi_i2swaptranm(flag,n,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swaptran(ictxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info) call psi_swaptran(ctxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_i2swaptranm end subroutine psi_i2swaptranm
subroutine psi_i2tranidxm(iictxt,iicomm,flag,n,beta,y,idx,& subroutine psi_i2tranidxm(ictxt,iicomm,flag,n,beta,y,idx,&
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_i2tranidxm use psi_mod, psb_protect_name => psi_i2tranidxm
@ -174,7 +174,7 @@ subroutine psi_i2tranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: iictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: iicomm integer(psb_mpk_), intent(in) :: iicomm
integer(psb_ipk_), intent(in) :: flag,n integer(psb_ipk_), intent(in) :: flag,n
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -183,7 +183,7 @@ subroutine psi_i2tranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm, np, me,& integer(psb_mpk_) :: icomm, np, me,&
& proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
@ -202,10 +202,10 @@ subroutine psi_i2tranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
info=psb_success_ info=psb_success_
name='psi_swap_tran' name='psi_swap_tran'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = iictxt ctxt = ictxt
icomm = iicomm icomm = iicomm
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -245,7 +245,7 @@ subroutine psi_i2tranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm)
brvidx(proc_to_comm) = rcv_pt brvidx(proc_to_comm) = rcv_pt
rvsz(proc_to_comm) = n*nerv rvsz(proc_to_comm) = n*nerv
@ -329,14 +329,14 @@ subroutine psi_i2tranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (proc_to_comm < me) then if (proc_to_comm < me) then
if (nerv>0) call psb_snd(ictxt,& if (nerv>0) call psb_snd(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
if (nesd>0) call psb_rcv(ictxt,& if (nesd>0) call psb_rcv(ctxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
else if (proc_to_comm > me) then else if (proc_to_comm > me) then
if (nesd>0) call psb_rcv(ictxt,& if (nesd>0) call psb_rcv(ctxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
if (nerv>0) call psb_snd(ictxt,& if (nerv>0) call psb_snd(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
else if (proc_to_comm == me) then else if (proc_to_comm == me) then
if (nesd /= nerv) then if (nesd /= nerv) then
@ -363,7 +363,7 @@ subroutine psi_i2tranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
p2ptag = psb_int2_swap_tag p2ptag = psb_int2_swap_tag
call mpi_irecv(sndbuf(snd_pt),n*nesd,& call mpi_irecv(sndbuf(snd_pt),n*nesd,&
@ -448,7 +448,7 @@ subroutine psi_i2tranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nerv>0) call psb_snd(ictxt,& if (nerv>0) call psb_snd(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
rcv_pt = rcv_pt + n*nerv rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd snd_pt = snd_pt + n*nesd
@ -465,7 +465,7 @@ subroutine psi_i2tranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nesd>0) call psb_rcv(ictxt,& if (nesd>0) call psb_rcv(ctxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
rcv_pt = rcv_pt + n*nerv rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd snd_pt = snd_pt + n*nesd
@ -513,7 +513,7 @@ subroutine psi_i2tranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_i2tranidxm end subroutine psi_i2tranidxm
@ -597,7 +597,7 @@ subroutine psi_i2swaptranv(flag,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_
integer(psb_ipk_), pointer :: d_idx(:) integer(psb_ipk_), pointer :: d_idx(:)
@ -607,9 +607,9 @@ subroutine psi_i2swaptranv(flag,beta,y,desc_a,work,info,data)
name='psi_swap_tranv' name='psi_swap_tranv'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -634,13 +634,13 @@ subroutine psi_i2swaptranv(flag,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swaptran(ictxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) call psi_swaptran(ctxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_i2swaptranv end subroutine psi_i2swaptranv
@ -656,7 +656,7 @@ end subroutine psi_i2swaptranv
! !
! !
! !
subroutine psi_i2tranidxv(iictxt,iicomm,flag,beta,y,idx,& subroutine psi_i2tranidxv(ictxt,iicomm,flag,beta,y,idx,&
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_i2tranidxv use psi_mod, psb_protect_name => psi_i2tranidxv
@ -671,7 +671,7 @@ subroutine psi_i2tranidxv(iictxt,iicomm,flag,beta,y,idx,&
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: iictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: iicomm integer(psb_mpk_), intent(in) :: iicomm
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -680,7 +680,7 @@ subroutine psi_i2tranidxv(iictxt,iicomm,flag,beta,y,idx,&
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm, np, me,& integer(psb_mpk_) :: icomm, np, me,&
& proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
@ -699,10 +699,10 @@ subroutine psi_i2tranidxv(iictxt,iicomm,flag,beta,y,idx,&
info=psb_success_ info=psb_success_
name='psi_swap_tran' name='psi_swap_tran'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = iictxt ctxt = ictxt
icomm = iicomm icomm = iicomm
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -742,7 +742,7 @@ subroutine psi_i2tranidxv(iictxt,iicomm,flag,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm)
brvidx(proc_to_comm) = rcv_pt brvidx(proc_to_comm) = rcv_pt
rvsz(proc_to_comm) = nerv rvsz(proc_to_comm) = nerv
@ -827,14 +827,14 @@ subroutine psi_i2tranidxv(iictxt,iicomm,flag,beta,y,idx,&
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (proc_to_comm < me) then if (proc_to_comm < me) then
if (nerv>0) call psb_snd(ictxt,& if (nerv>0) call psb_snd(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
if (nesd>0) call psb_rcv(ictxt,& if (nesd>0) call psb_rcv(ctxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
else if (proc_to_comm > me) then else if (proc_to_comm > me) then
if (nesd>0) call psb_rcv(ictxt,& if (nesd>0) call psb_rcv(ctxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
if (nerv>0) call psb_snd(ictxt,& if (nerv>0) call psb_snd(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
else if (proc_to_comm == me) then else if (proc_to_comm == me) then
if (nesd /= nerv) then if (nesd /= nerv) then
@ -860,7 +860,7 @@ subroutine psi_i2tranidxv(iictxt,iicomm,flag,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
p2ptag = psb_int2_swap_tag p2ptag = psb_int2_swap_tag
call mpi_irecv(sndbuf(snd_pt),nesd,& call mpi_irecv(sndbuf(snd_pt),nesd,&
@ -943,7 +943,7 @@ subroutine psi_i2tranidxv(iictxt,iicomm,flag,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nerv>0) call psb_snd(ictxt,& if (nerv>0) call psb_snd(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd snd_pt = snd_pt + nesd
@ -959,7 +959,7 @@ subroutine psi_i2tranidxv(iictxt,iicomm,flag,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nesd>0) call psb_rcv(ictxt,& if (nesd>0) call psb_rcv(ctxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd snd_pt = snd_pt + nesd
@ -1006,7 +1006,7 @@ subroutine psi_i2tranidxv(iictxt,iicomm,flag,beta,y,idx,&
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_i2tranidxv end subroutine psi_i2tranidxv

16
base/comm/internals/psi_iovrl_restr.f90
Unescape Escape View File

@ -47,7 +47,7 @@ subroutine psi_iovrl_restr_vect(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz integer(psb_ipk_) :: np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -57,8 +57,8 @@ subroutine psi_iovrl_restr_vect(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -72,7 +72,7 @@ subroutine psi_iovrl_restr_vect(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_iovrl_restr_vect end subroutine psi_iovrl_restr_vect
@ -90,7 +90,7 @@ subroutine psi_iovrl_restr_multivect(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -100,8 +100,8 @@ subroutine psi_iovrl_restr_multivect(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -114,7 +114,7 @@ subroutine psi_iovrl_restr_multivect(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_iovrl_restr_multivect end subroutine psi_iovrl_restr_multivect

16
base/comm/internals/psi_iovrl_save.f90
Unescape Escape View File

@ -47,7 +47,7 @@ subroutine psi_iovrl_save_vect(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz integer(psb_ipk_) :: np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -57,8 +57,8 @@ subroutine psi_iovrl_save_vect(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -78,7 +78,7 @@ subroutine psi_iovrl_save_vect(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_iovrl_save_vect end subroutine psi_iovrl_save_vect
@ -96,7 +96,7 @@ subroutine psi_iovrl_save_multivect(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -106,8 +106,8 @@ subroutine psi_iovrl_save_multivect(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -128,7 +128,7 @@ subroutine psi_iovrl_save_multivect(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_iovrl_save_multivect end subroutine psi_iovrl_save_multivect

16
base/comm/internals/psi_iovrl_upd.f90
Unescape Escape View File

@ -50,7 +50,7 @@ subroutine psi_iovrl_upd_vect(x,desc_a,update,info)
! locals ! locals
integer(psb_ipk_), allocatable :: xs(:) integer(psb_ipk_), allocatable :: xs(:)
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -62,8 +62,8 @@ subroutine psi_iovrl_upd_vect(x,desc_a,update,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -113,7 +113,7 @@ subroutine psi_iovrl_upd_vect(x,desc_a,update,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_iovrl_upd_vect end subroutine psi_iovrl_upd_vect
@ -132,7 +132,7 @@ subroutine psi_iovrl_upd_multivect(x,desc_a,update,info)
! locals ! locals
integer(psb_ipk_), allocatable :: xs(:,:) integer(psb_ipk_), allocatable :: xs(:,:)
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx, nc integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx, nc
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -144,8 +144,8 @@ subroutine psi_iovrl_upd_multivect(x,desc_a,update,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -196,7 +196,7 @@ subroutine psi_iovrl_upd_multivect(x,desc_a,update,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_iovrl_upd_multivect end subroutine psi_iovrl_upd_multivect

48
base/comm/internals/psi_iswapdata.F90
Unescape Escape View File

@ -113,7 +113,7 @@ subroutine psi_iswapdata_vect(flag,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act
class(psb_i_base_vect_type), pointer :: d_vidx class(psb_i_base_vect_type), pointer :: d_vidx
@ -123,9 +123,9 @@ subroutine psi_iswapdata_vect(flag,beta,y,desc_a,work,info,data)
name='psi_swap_datav' name='psi_swap_datav'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -150,13 +150,13 @@ subroutine psi_iswapdata_vect(flag,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swapdata(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) call psi_swapdata(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_iswapdata_vect end subroutine psi_iswapdata_vect
@ -175,7 +175,7 @@ end subroutine psi_iswapdata_vect
! !
! !
! !
subroutine psi_iswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & subroutine psi_iswap_vidx_vect(ictxt,iicomm,flag,beta,y,idx, &
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_iswap_vidx_vect use psi_mod, psb_protect_name => psi_iswap_vidx_vect
@ -192,7 +192,7 @@ subroutine psi_iswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: iictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: iicomm integer(psb_mpk_), intent(in) :: iicomm
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -203,7 +203,7 @@ subroutine psi_iswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm, np, me,& integer(psb_mpk_) :: icomm, np, me,&
& proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable :: prcid(:) integer(psb_mpk_), allocatable :: prcid(:)
@ -218,10 +218,10 @@ subroutine psi_iswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
info=psb_success_ info=psb_success_
name='psi_swap_datav' name='psi_swap_datav'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = iictxt ctxt = ictxt
icomm = iicomm icomm = iicomm
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -265,7 +265,7 @@ subroutine psi_iswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
nesd = idx%v(pnti+nerv+psb_n_elem_send_) nesd = idx%v(pnti+nerv+psb_n_elem_send_)
rcv_pt = 1+pnti+psb_n_elem_recv_ rcv_pt = 1+pnti+psb_n_elem_recv_
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt
p2ptag = psb_int_swap_tag p2ptag = psb_int_swap_tag
@ -418,7 +418,7 @@ subroutine psi_iswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_iswap_vidx_vect end subroutine psi_iswap_vidx_vect
@ -455,7 +455,7 @@ subroutine psi_iswapdata_multivect(flag,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act
class(psb_i_base_vect_type), pointer :: d_vidx class(psb_i_base_vect_type), pointer :: d_vidx
@ -465,9 +465,9 @@ subroutine psi_iswapdata_multivect(flag,beta,y,desc_a,work,info,data)
name='psi_swap_datav' name='psi_swap_datav'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -492,13 +492,13 @@ subroutine psi_iswapdata_multivect(flag,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swapdata(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) call psi_swapdata(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_iswapdata_multivect end subroutine psi_iswapdata_multivect
@ -517,7 +517,7 @@ end subroutine psi_iswapdata_multivect
! !
! !
! !
subroutine psi_iswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & subroutine psi_iswap_vidx_multivect(ictxt,iicomm,flag,beta,y,idx, &
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_iswap_vidx_multivect use psi_mod, psb_protect_name => psi_iswap_vidx_multivect
@ -534,7 +534,7 @@ subroutine psi_iswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: iictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: iicomm integer(psb_mpk_), intent(in) :: iicomm
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -545,7 +545,7 @@ subroutine psi_iswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm, np, me,& integer(psb_mpk_) :: icomm, np, me,&
& proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable :: prcid(:) integer(psb_mpk_), allocatable :: prcid(:)
@ -560,10 +560,10 @@ subroutine psi_iswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
info=psb_success_ info=psb_success_
name='psi_swap_datav' name='psi_swap_datav'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = iictxt ctxt = ictxt
icomm = iicomm icomm = iicomm
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -609,7 +609,7 @@ subroutine psi_iswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
proc_to_comm = idx%v(pnti+psb_proc_id_) proc_to_comm = idx%v(pnti+psb_proc_id_)
nerv = idx%v(pnti+psb_n_elem_recv_) nerv = idx%v(pnti+psb_n_elem_recv_)
nesd = idx%v(pnti+nerv+psb_n_elem_send_) nesd = idx%v(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt
p2ptag = psb_int_swap_tag p2ptag = psb_int_swap_tag
@ -766,7 +766,7 @@ subroutine psi_iswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_iswap_vidx_multivect end subroutine psi_iswap_vidx_multivect

48
base/comm/internals/psi_iswaptran.F90
Unescape Escape View File

@ -115,7 +115,7 @@ subroutine psi_iswaptran_vect(flag,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_
class(psb_i_base_vect_type), pointer :: d_vidx class(psb_i_base_vect_type), pointer :: d_vidx
@ -125,9 +125,9 @@ subroutine psi_iswaptran_vect(flag,beta,y,desc_a,work,info,data)
name='psi_swap_tranv' name='psi_swap_tranv'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -152,13 +152,13 @@ subroutine psi_iswaptran_vect(flag,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swaptran(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) call psi_swaptran(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_iswaptran_vect end subroutine psi_iswaptran_vect
@ -176,7 +176,7 @@ end subroutine psi_iswaptran_vect
! !
! !
! !
subroutine psi_itran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& subroutine psi_itran_vidx_vect(ictxt,iicomm,flag,beta,y,idx,&
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_itran_vidx_vect use psi_mod, psb_protect_name => psi_itran_vidx_vect
@ -193,7 +193,7 @@ subroutine psi_itran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: iictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: iicomm integer(psb_mpk_), intent(in) :: iicomm
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -204,7 +204,7 @@ subroutine psi_itran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm, np, me,& integer(psb_mpk_) :: icomm, np, me,&
& proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable :: prcid(:) integer(psb_mpk_), allocatable :: prcid(:)
@ -219,10 +219,10 @@ subroutine psi_itran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
info=psb_success_ info=psb_success_
name='psi_swap_tran' name='psi_swap_tran'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = iictxt ctxt = ictxt
icomm = iicomm icomm = iicomm
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -269,7 +269,7 @@ subroutine psi_itran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
snd_pt = 1+pnti+nerv+psb_n_elem_send_ snd_pt = 1+pnti+nerv+psb_n_elem_send_
rcv_pt = 1+pnti+psb_n_elem_recv_ rcv_pt = 1+pnti+psb_n_elem_recv_
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt
call mpi_irecv(y%combuf(snd_pt),nesd,& call mpi_irecv(y%combuf(snd_pt),nesd,&
@ -425,7 +425,7 @@ subroutine psi_itran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
@ -466,7 +466,7 @@ subroutine psi_iswaptran_multivect(flag,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_
class(psb_i_base_vect_type), pointer :: d_vidx class(psb_i_base_vect_type), pointer :: d_vidx
@ -476,9 +476,9 @@ subroutine psi_iswaptran_multivect(flag,beta,y,desc_a,work,info,data)
name='psi_swap_tranv' name='psi_swap_tranv'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -503,13 +503,13 @@ subroutine psi_iswaptran_multivect(flag,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swaptran(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) call psi_swaptran(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_iswaptran_multivect end subroutine psi_iswaptran_multivect
@ -528,7 +528,7 @@ subroutine psi_iswaptran_multivect(flag,beta,y,desc_a,work,info,data)
! !
! !
! !
subroutine psi_itran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& subroutine psi_itran_vidx_multivect(ictxt,iicomm,flag,beta,y,idx,&
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_itran_vidx_multivect use psi_mod, psb_protect_name => psi_itran_vidx_multivect
@ -545,7 +545,7 @@ subroutine psi_itran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: iictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: iicomm integer(psb_mpk_), intent(in) :: iicomm
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -556,7 +556,7 @@ subroutine psi_itran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm, np, me,& integer(psb_mpk_) :: icomm, np, me,&
& proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable :: prcid(:) integer(psb_mpk_), allocatable :: prcid(:)
@ -571,10 +571,10 @@ subroutine psi_itran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
info=psb_success_ info=psb_success_
name='psi_swap_tran' name='psi_swap_tran'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = iictxt ctxt = ictxt
icomm = iicomm icomm = iicomm
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -621,7 +621,7 @@ subroutine psi_itran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
proc_to_comm = idx%v(pnti+psb_proc_id_) proc_to_comm = idx%v(pnti+psb_proc_id_)
nerv = idx%v(pnti+psb_n_elem_recv_) nerv = idx%v(pnti+psb_n_elem_recv_)
nesd = idx%v(pnti+nerv+psb_n_elem_send_) nesd = idx%v(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
if (debug) write(*,*) me,'Posting receive from',prcid(i),snd_pt if (debug) write(*,*) me,'Posting receive from',prcid(i),snd_pt
call mpi_irecv(y%combuf(snd_pt),n*nesd,& call mpi_irecv(y%combuf(snd_pt),n*nesd,&
@ -781,7 +781,7 @@ subroutine psi_itran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return

16
base/comm/internals/psi_lovrl_restr.f90
Unescape Escape View File

@ -47,7 +47,7 @@ subroutine psi_lovrl_restr_vect(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz integer(psb_ipk_) :: np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -57,8 +57,8 @@ subroutine psi_lovrl_restr_vect(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -72,7 +72,7 @@ subroutine psi_lovrl_restr_vect(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_lovrl_restr_vect end subroutine psi_lovrl_restr_vect
@ -90,7 +90,7 @@ subroutine psi_lovrl_restr_multivect(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -100,8 +100,8 @@ subroutine psi_lovrl_restr_multivect(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -114,7 +114,7 @@ subroutine psi_lovrl_restr_multivect(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_lovrl_restr_multivect end subroutine psi_lovrl_restr_multivect

16
base/comm/internals/psi_lovrl_save.f90
Unescape Escape View File

@ -47,7 +47,7 @@ subroutine psi_lovrl_save_vect(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz integer(psb_ipk_) :: np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -57,8 +57,8 @@ subroutine psi_lovrl_save_vect(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -78,7 +78,7 @@ subroutine psi_lovrl_save_vect(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_lovrl_save_vect end subroutine psi_lovrl_save_vect
@ -96,7 +96,7 @@ subroutine psi_lovrl_save_multivect(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -106,8 +106,8 @@ subroutine psi_lovrl_save_multivect(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -128,7 +128,7 @@ subroutine psi_lovrl_save_multivect(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_lovrl_save_multivect end subroutine psi_lovrl_save_multivect

16
base/comm/internals/psi_lovrl_upd.f90
Unescape Escape View File

@ -50,7 +50,7 @@ subroutine psi_lovrl_upd_vect(x,desc_a,update,info)
! locals ! locals
integer(psb_lpk_), allocatable :: xs(:) integer(psb_lpk_), allocatable :: xs(:)
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -62,8 +62,8 @@ subroutine psi_lovrl_upd_vect(x,desc_a,update,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -113,7 +113,7 @@ subroutine psi_lovrl_upd_vect(x,desc_a,update,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_lovrl_upd_vect end subroutine psi_lovrl_upd_vect
@ -132,7 +132,7 @@ subroutine psi_lovrl_upd_multivect(x,desc_a,update,info)
! locals ! locals
integer(psb_lpk_), allocatable :: xs(:,:) integer(psb_lpk_), allocatable :: xs(:,:)
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx, nc integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx, nc
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -144,8 +144,8 @@ subroutine psi_lovrl_upd_multivect(x,desc_a,update,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -196,7 +196,7 @@ subroutine psi_lovrl_upd_multivect(x,desc_a,update,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_lovrl_upd_multivect end subroutine psi_lovrl_upd_multivect

48
base/comm/internals/psi_lswapdata.F90
Unescape Escape View File

@ -113,7 +113,7 @@ subroutine psi_lswapdata_vect(flag,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act
class(psb_i_base_vect_type), pointer :: d_vidx class(psb_i_base_vect_type), pointer :: d_vidx
@ -123,9 +123,9 @@ subroutine psi_lswapdata_vect(flag,beta,y,desc_a,work,info,data)
name='psi_swap_datav' name='psi_swap_datav'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -150,13 +150,13 @@ subroutine psi_lswapdata_vect(flag,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swapdata(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) call psi_swapdata(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_lswapdata_vect end subroutine psi_lswapdata_vect
@ -175,7 +175,7 @@ end subroutine psi_lswapdata_vect
! !
! !
! !
subroutine psi_lswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & subroutine psi_lswap_vidx_vect(ictxt,iicomm,flag,beta,y,idx, &
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_lswap_vidx_vect use psi_mod, psb_protect_name => psi_lswap_vidx_vect
@ -192,7 +192,7 @@ subroutine psi_lswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: iictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: iicomm integer(psb_mpk_), intent(in) :: iicomm
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -203,7 +203,7 @@ subroutine psi_lswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm, np, me,& integer(psb_mpk_) :: icomm, np, me,&
& proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable :: prcid(:) integer(psb_mpk_), allocatable :: prcid(:)
@ -218,10 +218,10 @@ subroutine psi_lswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
info=psb_success_ info=psb_success_
name='psi_swap_datav' name='psi_swap_datav'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = iictxt ctxt = ictxt
icomm = iicomm icomm = iicomm
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -265,7 +265,7 @@ subroutine psi_lswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
nesd = idx%v(pnti+nerv+psb_n_elem_send_) nesd = idx%v(pnti+nerv+psb_n_elem_send_)
rcv_pt = 1+pnti+psb_n_elem_recv_ rcv_pt = 1+pnti+psb_n_elem_recv_
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt
p2ptag = psb_long_swap_tag p2ptag = psb_long_swap_tag
@ -418,7 +418,7 @@ subroutine psi_lswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_lswap_vidx_vect end subroutine psi_lswap_vidx_vect
@ -455,7 +455,7 @@ subroutine psi_lswapdata_multivect(flag,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act
class(psb_i_base_vect_type), pointer :: d_vidx class(psb_i_base_vect_type), pointer :: d_vidx
@ -465,9 +465,9 @@ subroutine psi_lswapdata_multivect(flag,beta,y,desc_a,work,info,data)
name='psi_swap_datav' name='psi_swap_datav'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -492,13 +492,13 @@ subroutine psi_lswapdata_multivect(flag,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swapdata(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) call psi_swapdata(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_lswapdata_multivect end subroutine psi_lswapdata_multivect
@ -517,7 +517,7 @@ end subroutine psi_lswapdata_multivect
! !
! !
! !
subroutine psi_lswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & subroutine psi_lswap_vidx_multivect(ictxt,iicomm,flag,beta,y,idx, &
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_lswap_vidx_multivect use psi_mod, psb_protect_name => psi_lswap_vidx_multivect
@ -534,7 +534,7 @@ subroutine psi_lswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: iictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: iicomm integer(psb_mpk_), intent(in) :: iicomm
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -545,7 +545,7 @@ subroutine psi_lswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm, np, me,& integer(psb_mpk_) :: icomm, np, me,&
& proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable :: prcid(:) integer(psb_mpk_), allocatable :: prcid(:)
@ -560,10 +560,10 @@ subroutine psi_lswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
info=psb_success_ info=psb_success_
name='psi_swap_datav' name='psi_swap_datav'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = iictxt ctxt = ictxt
icomm = iicomm icomm = iicomm
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -609,7 +609,7 @@ subroutine psi_lswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
proc_to_comm = idx%v(pnti+psb_proc_id_) proc_to_comm = idx%v(pnti+psb_proc_id_)
nerv = idx%v(pnti+psb_n_elem_recv_) nerv = idx%v(pnti+psb_n_elem_recv_)
nesd = idx%v(pnti+nerv+psb_n_elem_send_) nesd = idx%v(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt
p2ptag = psb_long_swap_tag p2ptag = psb_long_swap_tag
@ -766,7 +766,7 @@ subroutine psi_lswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_lswap_vidx_multivect end subroutine psi_lswap_vidx_multivect

48
base/comm/internals/psi_lswaptran.F90
Unescape Escape View File

@ -115,7 +115,7 @@ subroutine psi_lswaptran_vect(flag,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_
class(psb_i_base_vect_type), pointer :: d_vidx class(psb_i_base_vect_type), pointer :: d_vidx
@ -125,9 +125,9 @@ subroutine psi_lswaptran_vect(flag,beta,y,desc_a,work,info,data)
name='psi_swap_tranv' name='psi_swap_tranv'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -152,13 +152,13 @@ subroutine psi_lswaptran_vect(flag,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swaptran(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) call psi_swaptran(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_lswaptran_vect end subroutine psi_lswaptran_vect
@ -176,7 +176,7 @@ end subroutine psi_lswaptran_vect
! !
! !
! !
subroutine psi_ltran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& subroutine psi_ltran_vidx_vect(ictxt,iicomm,flag,beta,y,idx,&
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_ltran_vidx_vect use psi_mod, psb_protect_name => psi_ltran_vidx_vect
@ -193,7 +193,7 @@ subroutine psi_ltran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: iictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: iicomm integer(psb_mpk_), intent(in) :: iicomm
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -204,7 +204,7 @@ subroutine psi_ltran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm, np, me,& integer(psb_mpk_) :: icomm, np, me,&
& proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable :: prcid(:) integer(psb_mpk_), allocatable :: prcid(:)
@ -219,10 +219,10 @@ subroutine psi_ltran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
info=psb_success_ info=psb_success_
name='psi_swap_tran' name='psi_swap_tran'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = iictxt ctxt = ictxt
icomm = iicomm icomm = iicomm
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -269,7 +269,7 @@ subroutine psi_ltran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
snd_pt = 1+pnti+nerv+psb_n_elem_send_ snd_pt = 1+pnti+nerv+psb_n_elem_send_
rcv_pt = 1+pnti+psb_n_elem_recv_ rcv_pt = 1+pnti+psb_n_elem_recv_
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt
call mpi_irecv(y%combuf(snd_pt),nesd,& call mpi_irecv(y%combuf(snd_pt),nesd,&
@ -425,7 +425,7 @@ subroutine psi_ltran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
@ -466,7 +466,7 @@ subroutine psi_lswaptran_multivect(flag,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_
class(psb_i_base_vect_type), pointer :: d_vidx class(psb_i_base_vect_type), pointer :: d_vidx
@ -476,9 +476,9 @@ subroutine psi_lswaptran_multivect(flag,beta,y,desc_a,work,info,data)
name='psi_swap_tranv' name='psi_swap_tranv'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -503,13 +503,13 @@ subroutine psi_lswaptran_multivect(flag,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swaptran(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) call psi_swaptran(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_lswaptran_multivect end subroutine psi_lswaptran_multivect
@ -528,7 +528,7 @@ subroutine psi_lswaptran_multivect(flag,beta,y,desc_a,work,info,data)
! !
! !
! !
subroutine psi_ltran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& subroutine psi_ltran_vidx_multivect(ictxt,iicomm,flag,beta,y,idx,&
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_ltran_vidx_multivect use psi_mod, psb_protect_name => psi_ltran_vidx_multivect
@ -545,7 +545,7 @@ subroutine psi_ltran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: iictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: iicomm integer(psb_mpk_), intent(in) :: iicomm
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -556,7 +556,7 @@ subroutine psi_ltran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm, np, me,& integer(psb_mpk_) :: icomm, np, me,&
& proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable :: prcid(:) integer(psb_mpk_), allocatable :: prcid(:)
@ -571,10 +571,10 @@ subroutine psi_ltran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
info=psb_success_ info=psb_success_
name='psi_swap_tran' name='psi_swap_tran'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = iictxt ctxt = ictxt
icomm = iicomm icomm = iicomm
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -621,7 +621,7 @@ subroutine psi_ltran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
proc_to_comm = idx%v(pnti+psb_proc_id_) proc_to_comm = idx%v(pnti+psb_proc_id_)
nerv = idx%v(pnti+psb_n_elem_recv_) nerv = idx%v(pnti+psb_n_elem_recv_)
nesd = idx%v(pnti+nerv+psb_n_elem_send_) nesd = idx%v(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
if (debug) write(*,*) me,'Posting receive from',prcid(i),snd_pt if (debug) write(*,*) me,'Posting receive from',prcid(i),snd_pt
call mpi_irecv(y%combuf(snd_pt),n*nesd,& call mpi_irecv(y%combuf(snd_pt),n*nesd,&
@ -781,7 +781,7 @@ subroutine psi_ltran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return

16
base/comm/internals/psi_movrl_restr_a.f90
Unescape Escape View File

@ -45,7 +45,7 @@ subroutine psi_movrl_restrr1(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz integer(psb_ipk_) :: np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -55,8 +55,8 @@ subroutine psi_movrl_restrr1(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -73,7 +73,7 @@ subroutine psi_movrl_restrr1(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_movrl_restrr1 end subroutine psi_movrl_restrr1
@ -89,7 +89,7 @@ subroutine psi_movrl_restrr2(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz integer(psb_ipk_) :: np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -99,8 +99,8 @@ subroutine psi_movrl_restrr2(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -124,7 +124,7 @@ subroutine psi_movrl_restrr2(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_movrl_restrr2 end subroutine psi_movrl_restrr2

16
base/comm/internals/psi_movrl_save_a.f90
Unescape Escape View File

@ -47,7 +47,7 @@ subroutine psi_movrl_saver1(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz integer(psb_ipk_) :: np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -57,8 +57,8 @@ subroutine psi_movrl_saver1(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -81,7 +81,7 @@ subroutine psi_movrl_saver1(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_movrl_saver1 end subroutine psi_movrl_saver1
@ -100,7 +100,7 @@ subroutine psi_movrl_saver2(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -110,8 +110,8 @@ subroutine psi_movrl_saver2(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -135,7 +135,7 @@ subroutine psi_movrl_saver2(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_movrl_saver2 end subroutine psi_movrl_saver2

16
base/comm/internals/psi_movrl_upd_a.f90
Unescape Escape View File

@ -46,7 +46,7 @@ subroutine psi_movrl_updr1(x,desc_a,update,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, ndm integer(psb_ipk_) :: np, me, err_act, i, idx, ndm
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -57,8 +57,8 @@ subroutine psi_movrl_updr1(x,desc_a,update,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -99,7 +99,7 @@ subroutine psi_movrl_updr1(x,desc_a,update,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_movrl_updr1 end subroutine psi_movrl_updr1
@ -115,7 +115,7 @@ subroutine psi_movrl_updr2(x,desc_a,update,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, ndm integer(psb_ipk_) :: np, me, err_act, i, idx, ndm
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -126,8 +126,8 @@ subroutine psi_movrl_updr2(x,desc_a,update,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -168,7 +168,7 @@ subroutine psi_movrl_updr2(x,desc_a,update,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_movrl_updr2 end subroutine psi_movrl_updr2

72
base/comm/internals/psi_mswapdata_a.F90
Unescape Escape View File

@ -106,7 +106,7 @@ subroutine psi_mswapdatam(flag,n,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act
integer(psb_ipk_), pointer :: d_idx(:) integer(psb_ipk_), pointer :: d_idx(:)
@ -116,9 +116,9 @@ subroutine psi_mswapdatam(flag,n,beta,y,desc_a,work,info,data)
name='psi_swap_data' name='psi_swap_data'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -143,18 +143,18 @@ subroutine psi_mswapdatam(flag,n,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swapdata(ictxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info) call psi_swapdata(ctxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_mswapdatam end subroutine psi_mswapdatam
subroutine psi_mswapidxm(ictxt,icomm,flag,n,beta,y,idx, & subroutine psi_mswapidxm(ctxt,icomm,flag,n,beta,y,idx, &
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_mswapidxm use psi_mod, psb_protect_name => psi_mswapidxm
@ -169,7 +169,7 @@ subroutine psi_mswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: icomm integer(psb_mpk_), intent(in) :: icomm
integer(psb_ipk_), intent(in) :: flag,n integer(psb_ipk_), intent(in) :: flag,n
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -198,7 +198,7 @@ subroutine psi_mswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
name='psi_swap_data' name='psi_swap_data'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -238,7 +238,7 @@ subroutine psi_mswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm)
brvidx(proc_to_comm) = rcv_pt brvidx(proc_to_comm) = rcv_pt
rvsz(proc_to_comm) = n*nerv rvsz(proc_to_comm) = n*nerv
@ -317,14 +317,14 @@ subroutine psi_mswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (proc_to_comm < me) then if (proc_to_comm < me) then
if (nesd>0) call psb_snd(ictxt,& if (nesd>0) call psb_snd(ctxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
if (nerv>0) call psb_rcv(ictxt,& if (nerv>0) call psb_rcv(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
else if (proc_to_comm > me) then else if (proc_to_comm > me) then
if (nerv>0) call psb_rcv(ictxt,& if (nerv>0) call psb_rcv(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
if (nesd>0) call psb_snd(ictxt,& if (nesd>0) call psb_snd(ctxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
else if (proc_to_comm == me) then else if (proc_to_comm == me) then
if (nesd /= nerv) then if (nesd /= nerv) then
@ -351,7 +351,7 @@ subroutine psi_mswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_int4_swap_tag p2ptag = psb_int4_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),n*nerv,& call mpi_irecv(rcvbuf(rcv_pt),n*nerv,&
@ -436,7 +436,7 @@ subroutine psi_mswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nesd>0) call psb_snd(ictxt,& if (nesd>0) call psb_snd(ctxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
rcv_pt = rcv_pt + n*nerv rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd snd_pt = snd_pt + n*nesd
@ -453,7 +453,7 @@ subroutine psi_mswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nerv>0) call psb_rcv(ictxt,& if (nerv>0) call psb_rcv(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
rcv_pt = rcv_pt + n*nerv rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd snd_pt = snd_pt + n*nesd
@ -501,7 +501,7 @@ subroutine psi_mswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_mswapidxm end subroutine psi_mswapidxm
@ -582,7 +582,7 @@ subroutine psi_mswapdatav(flag,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act
integer(psb_ipk_), pointer :: d_idx(:) integer(psb_ipk_), pointer :: d_idx(:)
@ -592,9 +592,9 @@ subroutine psi_mswapdatav(flag,beta,y,desc_a,work,info,data)
name='psi_swap_datav' name='psi_swap_datav'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -619,13 +619,13 @@ subroutine psi_mswapdatav(flag,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swapdata(ictxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) call psi_swapdata(ctxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_mswapdatav end subroutine psi_mswapdatav
@ -641,7 +641,7 @@ end subroutine psi_mswapdatav
! !
! !
! !
subroutine psi_mswapidxv(iictxt,iicomm,flag,beta,y,idx, & subroutine psi_mswapidxv(ictxt,iicomm,flag,beta,y,idx, &
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_mswapidxv use psi_mod, psb_protect_name => psi_mswapidxv
@ -656,7 +656,7 @@ subroutine psi_mswapidxv(iictxt,iicomm,flag,beta,y,idx, &
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: iictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: iicomm integer(psb_mpk_), intent(in) :: iicomm
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -665,7 +665,7 @@ subroutine psi_mswapidxv(iictxt,iicomm,flag,beta,y,idx, &
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm, np, me,& integer(psb_mpk_) :: icomm, np, me,&
& proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
@ -684,10 +684,10 @@ subroutine psi_mswapidxv(iictxt,iicomm,flag,beta,y,idx, &
info=psb_success_ info=psb_success_
name='psi_swap_datav' name='psi_swap_datav'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = iictxt ctxt = ictxt
icomm = iicomm icomm = iicomm
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -727,7 +727,7 @@ subroutine psi_mswapidxv(iictxt,iicomm,flag,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm)
brvidx(proc_to_comm) = rcv_pt brvidx(proc_to_comm) = rcv_pt
rvsz(proc_to_comm) = nerv rvsz(proc_to_comm) = nerv
@ -807,14 +807,14 @@ subroutine psi_mswapidxv(iictxt,iicomm,flag,beta,y,idx, &
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (proc_to_comm < me) then if (proc_to_comm < me) then
if (nesd>0) call psb_snd(ictxt,& if (nesd>0) call psb_snd(ctxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
if (nerv>0) call psb_rcv(ictxt,& if (nerv>0) call psb_rcv(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
else if (proc_to_comm > me) then else if (proc_to_comm > me) then
if (nerv>0) call psb_rcv(ictxt,& if (nerv>0) call psb_rcv(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
if (nesd>0) call psb_snd(ictxt,& if (nesd>0) call psb_snd(ctxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
else if (proc_to_comm == me) then else if (proc_to_comm == me) then
if (nesd /= nerv) then if (nesd /= nerv) then
@ -841,7 +841,7 @@ subroutine psi_mswapidxv(iictxt,iicomm,flag,beta,y,idx, &
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_int4_swap_tag p2ptag = psb_int4_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),nerv,& call mpi_irecv(rcvbuf(rcv_pt),nerv,&
@ -925,7 +925,7 @@ subroutine psi_mswapidxv(iictxt,iicomm,flag,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nesd>0) call psb_snd(ictxt,& if (nesd>0) call psb_snd(ctxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd snd_pt = snd_pt + nesd
@ -941,7 +941,7 @@ subroutine psi_mswapidxv(iictxt,iicomm,flag,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nerv>0) call psb_rcv(ictxt,& if (nerv>0) call psb_rcv(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd snd_pt = snd_pt + nesd
@ -988,7 +988,7 @@ subroutine psi_mswapidxv(iictxt,iicomm,flag,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_mswapidxv end subroutine psi_mswapidxv

76
base/comm/internals/psi_mswaptran_a.F90
Unescape Escape View File

@ -110,7 +110,7 @@ subroutine psi_mswaptranm(flag,n,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, err_act, totxch, data_ integer(psb_ipk_) :: np, me, idxs, idxr, err_act, totxch, data_
integer(psb_ipk_), pointer :: d_idx(:) integer(psb_ipk_), pointer :: d_idx(:)
@ -120,10 +120,10 @@ subroutine psi_mswaptranm(flag,n,beta,y,desc_a,work,info,data)
name='psi_swap_tran' name='psi_swap_tran'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -148,18 +148,18 @@ subroutine psi_mswaptranm(flag,n,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swaptran(ictxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info) call psi_swaptran(ctxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_mswaptranm end subroutine psi_mswaptranm
subroutine psi_mtranidxm(iictxt,iicomm,flag,n,beta,y,idx,& subroutine psi_mtranidxm(ictxt,iicomm,flag,n,beta,y,idx,&
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_mtranidxm use psi_mod, psb_protect_name => psi_mtranidxm
@ -174,7 +174,7 @@ subroutine psi_mtranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: iictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: iicomm integer(psb_mpk_), intent(in) :: iicomm
integer(psb_ipk_), intent(in) :: flag,n integer(psb_ipk_), intent(in) :: flag,n
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -183,7 +183,7 @@ subroutine psi_mtranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm, np, me,& integer(psb_mpk_) :: icomm, np, me,&
& proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
@ -202,10 +202,10 @@ subroutine psi_mtranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
info=psb_success_ info=psb_success_
name='psi_swap_tran' name='psi_swap_tran'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = iictxt ctxt = ictxt
icomm = iicomm icomm = iicomm
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -245,7 +245,7 @@ subroutine psi_mtranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm)
brvidx(proc_to_comm) = rcv_pt brvidx(proc_to_comm) = rcv_pt
rvsz(proc_to_comm) = n*nerv rvsz(proc_to_comm) = n*nerv
@ -329,14 +329,14 @@ subroutine psi_mtranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (proc_to_comm < me) then if (proc_to_comm < me) then
if (nerv>0) call psb_snd(ictxt,& if (nerv>0) call psb_snd(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
if (nesd>0) call psb_rcv(ictxt,& if (nesd>0) call psb_rcv(ctxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
else if (proc_to_comm > me) then else if (proc_to_comm > me) then
if (nesd>0) call psb_rcv(ictxt,& if (nesd>0) call psb_rcv(ctxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
if (nerv>0) call psb_snd(ictxt,& if (nerv>0) call psb_snd(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
else if (proc_to_comm == me) then else if (proc_to_comm == me) then
if (nesd /= nerv) then if (nesd /= nerv) then
@ -363,7 +363,7 @@ subroutine psi_mtranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
p2ptag = psb_int4_swap_tag p2ptag = psb_int4_swap_tag
call mpi_irecv(sndbuf(snd_pt),n*nesd,& call mpi_irecv(sndbuf(snd_pt),n*nesd,&
@ -448,7 +448,7 @@ subroutine psi_mtranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nerv>0) call psb_snd(ictxt,& if (nerv>0) call psb_snd(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
rcv_pt = rcv_pt + n*nerv rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd snd_pt = snd_pt + n*nesd
@ -465,7 +465,7 @@ subroutine psi_mtranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nesd>0) call psb_rcv(ictxt,& if (nesd>0) call psb_rcv(ctxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
rcv_pt = rcv_pt + n*nerv rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd snd_pt = snd_pt + n*nesd
@ -513,7 +513,7 @@ subroutine psi_mtranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_mtranidxm end subroutine psi_mtranidxm
@ -597,7 +597,7 @@ subroutine psi_mswaptranv(flag,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_
integer(psb_ipk_), pointer :: d_idx(:) integer(psb_ipk_), pointer :: d_idx(:)
@ -607,9 +607,9 @@ subroutine psi_mswaptranv(flag,beta,y,desc_a,work,info,data)
name='psi_swap_tranv' name='psi_swap_tranv'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -634,13 +634,13 @@ subroutine psi_mswaptranv(flag,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swaptran(ictxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) call psi_swaptran(ctxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_mswaptranv end subroutine psi_mswaptranv
@ -656,7 +656,7 @@ end subroutine psi_mswaptranv
! !
! !
! !
subroutine psi_mtranidxv(iictxt,iicomm,flag,beta,y,idx,& subroutine psi_mtranidxv(ictxt,iicomm,flag,beta,y,idx,&
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_mtranidxv use psi_mod, psb_protect_name => psi_mtranidxv
@ -671,7 +671,7 @@ subroutine psi_mtranidxv(iictxt,iicomm,flag,beta,y,idx,&
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: iictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: iicomm integer(psb_mpk_), intent(in) :: iicomm
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -680,7 +680,7 @@ subroutine psi_mtranidxv(iictxt,iicomm,flag,beta,y,idx,&
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm, np, me,& integer(psb_mpk_) :: icomm, np, me,&
& proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
@ -699,10 +699,10 @@ subroutine psi_mtranidxv(iictxt,iicomm,flag,beta,y,idx,&
info=psb_success_ info=psb_success_
name='psi_swap_tran' name='psi_swap_tran'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = iictxt ctxt = ictxt
icomm = iicomm icomm = iicomm
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -742,7 +742,7 @@ subroutine psi_mtranidxv(iictxt,iicomm,flag,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm)
brvidx(proc_to_comm) = rcv_pt brvidx(proc_to_comm) = rcv_pt
rvsz(proc_to_comm) = nerv rvsz(proc_to_comm) = nerv
@ -827,14 +827,14 @@ subroutine psi_mtranidxv(iictxt,iicomm,flag,beta,y,idx,&
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (proc_to_comm < me) then if (proc_to_comm < me) then
if (nerv>0) call psb_snd(ictxt,& if (nerv>0) call psb_snd(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
if (nesd>0) call psb_rcv(ictxt,& if (nesd>0) call psb_rcv(ctxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
else if (proc_to_comm > me) then else if (proc_to_comm > me) then
if (nesd>0) call psb_rcv(ictxt,& if (nesd>0) call psb_rcv(ctxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
if (nerv>0) call psb_snd(ictxt,& if (nerv>0) call psb_snd(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
else if (proc_to_comm == me) then else if (proc_to_comm == me) then
if (nesd /= nerv) then if (nesd /= nerv) then
@ -860,7 +860,7 @@ subroutine psi_mtranidxv(iictxt,iicomm,flag,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
p2ptag = psb_int4_swap_tag p2ptag = psb_int4_swap_tag
call mpi_irecv(sndbuf(snd_pt),nesd,& call mpi_irecv(sndbuf(snd_pt),nesd,&
@ -943,7 +943,7 @@ subroutine psi_mtranidxv(iictxt,iicomm,flag,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nerv>0) call psb_snd(ictxt,& if (nerv>0) call psb_snd(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd snd_pt = snd_pt + nesd
@ -959,7 +959,7 @@ subroutine psi_mtranidxv(iictxt,iicomm,flag,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nesd>0) call psb_rcv(ictxt,& if (nesd>0) call psb_rcv(ctxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd snd_pt = snd_pt + nesd
@ -1006,7 +1006,7 @@ subroutine psi_mtranidxv(iictxt,iicomm,flag,beta,y,idx,&
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_mtranidxv end subroutine psi_mtranidxv

16
base/comm/internals/psi_sovrl_restr.f90
Unescape Escape View File

@ -47,7 +47,7 @@ subroutine psi_sovrl_restr_vect(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz integer(psb_ipk_) :: np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -57,8 +57,8 @@ subroutine psi_sovrl_restr_vect(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -72,7 +72,7 @@ subroutine psi_sovrl_restr_vect(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_sovrl_restr_vect end subroutine psi_sovrl_restr_vect
@ -90,7 +90,7 @@ subroutine psi_sovrl_restr_multivect(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -100,8 +100,8 @@ subroutine psi_sovrl_restr_multivect(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -114,7 +114,7 @@ subroutine psi_sovrl_restr_multivect(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_sovrl_restr_multivect end subroutine psi_sovrl_restr_multivect

16
base/comm/internals/psi_sovrl_restr_a.f90
Unescape Escape View File

@ -45,7 +45,7 @@ subroutine psi_sovrl_restrr1(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz integer(psb_ipk_) :: np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -55,8 +55,8 @@ subroutine psi_sovrl_restrr1(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -73,7 +73,7 @@ subroutine psi_sovrl_restrr1(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_sovrl_restrr1 end subroutine psi_sovrl_restrr1
@ -89,7 +89,7 @@ subroutine psi_sovrl_restrr2(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz integer(psb_ipk_) :: np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -99,8 +99,8 @@ subroutine psi_sovrl_restrr2(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -124,7 +124,7 @@ subroutine psi_sovrl_restrr2(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_sovrl_restrr2 end subroutine psi_sovrl_restrr2

16
base/comm/internals/psi_sovrl_save.f90
Unescape Escape View File

@ -47,7 +47,7 @@ subroutine psi_sovrl_save_vect(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz integer(psb_ipk_) :: np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -57,8 +57,8 @@ subroutine psi_sovrl_save_vect(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -78,7 +78,7 @@ subroutine psi_sovrl_save_vect(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_sovrl_save_vect end subroutine psi_sovrl_save_vect
@ -96,7 +96,7 @@ subroutine psi_sovrl_save_multivect(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -106,8 +106,8 @@ subroutine psi_sovrl_save_multivect(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -128,7 +128,7 @@ subroutine psi_sovrl_save_multivect(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_sovrl_save_multivect end subroutine psi_sovrl_save_multivect

16
base/comm/internals/psi_sovrl_save_a.f90
Unescape Escape View File

@ -47,7 +47,7 @@ subroutine psi_sovrl_saver1(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz integer(psb_ipk_) :: np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -57,8 +57,8 @@ subroutine psi_sovrl_saver1(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -81,7 +81,7 @@ subroutine psi_sovrl_saver1(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_sovrl_saver1 end subroutine psi_sovrl_saver1
@ -100,7 +100,7 @@ subroutine psi_sovrl_saver2(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -110,8 +110,8 @@ subroutine psi_sovrl_saver2(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -135,7 +135,7 @@ subroutine psi_sovrl_saver2(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_sovrl_saver2 end subroutine psi_sovrl_saver2

16
base/comm/internals/psi_sovrl_upd.f90
Unescape Escape View File

@ -50,7 +50,7 @@ subroutine psi_sovrl_upd_vect(x,desc_a,update,info)
! locals ! locals
real(psb_spk_), allocatable :: xs(:) real(psb_spk_), allocatable :: xs(:)
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -62,8 +62,8 @@ subroutine psi_sovrl_upd_vect(x,desc_a,update,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -113,7 +113,7 @@ subroutine psi_sovrl_upd_vect(x,desc_a,update,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_sovrl_upd_vect end subroutine psi_sovrl_upd_vect
@ -132,7 +132,7 @@ subroutine psi_sovrl_upd_multivect(x,desc_a,update,info)
! locals ! locals
real(psb_spk_), allocatable :: xs(:,:) real(psb_spk_), allocatable :: xs(:,:)
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx, nc integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx, nc
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -144,8 +144,8 @@ subroutine psi_sovrl_upd_multivect(x,desc_a,update,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -196,7 +196,7 @@ subroutine psi_sovrl_upd_multivect(x,desc_a,update,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_sovrl_upd_multivect end subroutine psi_sovrl_upd_multivect

16
base/comm/internals/psi_sovrl_upd_a.f90
Unescape Escape View File

@ -46,7 +46,7 @@ subroutine psi_sovrl_updr1(x,desc_a,update,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, ndm integer(psb_ipk_) :: np, me, err_act, i, idx, ndm
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -57,8 +57,8 @@ subroutine psi_sovrl_updr1(x,desc_a,update,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -99,7 +99,7 @@ subroutine psi_sovrl_updr1(x,desc_a,update,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_sovrl_updr1 end subroutine psi_sovrl_updr1
@ -115,7 +115,7 @@ subroutine psi_sovrl_updr2(x,desc_a,update,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, ndm integer(psb_ipk_) :: np, me, err_act, i, idx, ndm
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -126,8 +126,8 @@ subroutine psi_sovrl_updr2(x,desc_a,update,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -168,7 +168,7 @@ subroutine psi_sovrl_updr2(x,desc_a,update,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_sovrl_updr2 end subroutine psi_sovrl_updr2

48
base/comm/internals/psi_sswapdata.F90
Unescape Escape View File

@ -113,7 +113,7 @@ subroutine psi_sswapdata_vect(flag,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act
class(psb_i_base_vect_type), pointer :: d_vidx class(psb_i_base_vect_type), pointer :: d_vidx
@ -123,9 +123,9 @@ subroutine psi_sswapdata_vect(flag,beta,y,desc_a,work,info,data)
name='psi_swap_datav' name='psi_swap_datav'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -150,13 +150,13 @@ subroutine psi_sswapdata_vect(flag,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swapdata(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) call psi_swapdata(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_sswapdata_vect end subroutine psi_sswapdata_vect
@ -175,7 +175,7 @@ end subroutine psi_sswapdata_vect
! !
! !
! !
subroutine psi_sswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & subroutine psi_sswap_vidx_vect(ictxt,iicomm,flag,beta,y,idx, &
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_sswap_vidx_vect use psi_mod, psb_protect_name => psi_sswap_vidx_vect
@ -192,7 +192,7 @@ subroutine psi_sswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: iictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: iicomm integer(psb_mpk_), intent(in) :: iicomm
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -203,7 +203,7 @@ subroutine psi_sswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm, np, me,& integer(psb_mpk_) :: icomm, np, me,&
& proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable :: prcid(:) integer(psb_mpk_), allocatable :: prcid(:)
@ -218,10 +218,10 @@ subroutine psi_sswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
info=psb_success_ info=psb_success_
name='psi_swap_datav' name='psi_swap_datav'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = iictxt ctxt = ictxt
icomm = iicomm icomm = iicomm
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -265,7 +265,7 @@ subroutine psi_sswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
nesd = idx%v(pnti+nerv+psb_n_elem_send_) nesd = idx%v(pnti+nerv+psb_n_elem_send_)
rcv_pt = 1+pnti+psb_n_elem_recv_ rcv_pt = 1+pnti+psb_n_elem_recv_
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt
p2ptag = psb_real_swap_tag p2ptag = psb_real_swap_tag
@ -418,7 +418,7 @@ subroutine psi_sswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_sswap_vidx_vect end subroutine psi_sswap_vidx_vect
@ -455,7 +455,7 @@ subroutine psi_sswapdata_multivect(flag,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act
class(psb_i_base_vect_type), pointer :: d_vidx class(psb_i_base_vect_type), pointer :: d_vidx
@ -465,9 +465,9 @@ subroutine psi_sswapdata_multivect(flag,beta,y,desc_a,work,info,data)
name='psi_swap_datav' name='psi_swap_datav'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -492,13 +492,13 @@ subroutine psi_sswapdata_multivect(flag,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swapdata(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) call psi_swapdata(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_sswapdata_multivect end subroutine psi_sswapdata_multivect
@ -517,7 +517,7 @@ end subroutine psi_sswapdata_multivect
! !
! !
! !
subroutine psi_sswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & subroutine psi_sswap_vidx_multivect(ictxt,iicomm,flag,beta,y,idx, &
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_sswap_vidx_multivect use psi_mod, psb_protect_name => psi_sswap_vidx_multivect
@ -534,7 +534,7 @@ subroutine psi_sswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: iictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: iicomm integer(psb_mpk_), intent(in) :: iicomm
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -545,7 +545,7 @@ subroutine psi_sswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm, np, me,& integer(psb_mpk_) :: icomm, np, me,&
& proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable :: prcid(:) integer(psb_mpk_), allocatable :: prcid(:)
@ -560,10 +560,10 @@ subroutine psi_sswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
info=psb_success_ info=psb_success_
name='psi_swap_datav' name='psi_swap_datav'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = iictxt ctxt = ictxt
icomm = iicomm icomm = iicomm
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -609,7 +609,7 @@ subroutine psi_sswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
proc_to_comm = idx%v(pnti+psb_proc_id_) proc_to_comm = idx%v(pnti+psb_proc_id_)
nerv = idx%v(pnti+psb_n_elem_recv_) nerv = idx%v(pnti+psb_n_elem_recv_)
nesd = idx%v(pnti+nerv+psb_n_elem_send_) nesd = idx%v(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt
p2ptag = psb_real_swap_tag p2ptag = psb_real_swap_tag
@ -766,7 +766,7 @@ subroutine psi_sswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_sswap_vidx_multivect end subroutine psi_sswap_vidx_multivect

72
base/comm/internals/psi_sswapdata_a.F90
Unescape Escape View File

@ -106,7 +106,7 @@ subroutine psi_sswapdatam(flag,n,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act
integer(psb_ipk_), pointer :: d_idx(:) integer(psb_ipk_), pointer :: d_idx(:)
@ -116,9 +116,9 @@ subroutine psi_sswapdatam(flag,n,beta,y,desc_a,work,info,data)
name='psi_swap_data' name='psi_swap_data'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -143,18 +143,18 @@ subroutine psi_sswapdatam(flag,n,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swapdata(ictxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info) call psi_swapdata(ctxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_sswapdatam end subroutine psi_sswapdatam
subroutine psi_sswapidxm(ictxt,icomm,flag,n,beta,y,idx, & subroutine psi_sswapidxm(ctxt,icomm,flag,n,beta,y,idx, &
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_sswapidxm use psi_mod, psb_protect_name => psi_sswapidxm
@ -169,7 +169,7 @@ subroutine psi_sswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: icomm integer(psb_mpk_), intent(in) :: icomm
integer(psb_ipk_), intent(in) :: flag,n integer(psb_ipk_), intent(in) :: flag,n
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -198,7 +198,7 @@ subroutine psi_sswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
name='psi_swap_data' name='psi_swap_data'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -238,7 +238,7 @@ subroutine psi_sswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm)
brvidx(proc_to_comm) = rcv_pt brvidx(proc_to_comm) = rcv_pt
rvsz(proc_to_comm) = n*nerv rvsz(proc_to_comm) = n*nerv
@ -317,14 +317,14 @@ subroutine psi_sswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (proc_to_comm < me) then if (proc_to_comm < me) then
if (nesd>0) call psb_snd(ictxt,& if (nesd>0) call psb_snd(ctxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
if (nerv>0) call psb_rcv(ictxt,& if (nerv>0) call psb_rcv(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
else if (proc_to_comm > me) then else if (proc_to_comm > me) then
if (nerv>0) call psb_rcv(ictxt,& if (nerv>0) call psb_rcv(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
if (nesd>0) call psb_snd(ictxt,& if (nesd>0) call psb_snd(ctxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
else if (proc_to_comm == me) then else if (proc_to_comm == me) then
if (nesd /= nerv) then if (nesd /= nerv) then
@ -351,7 +351,7 @@ subroutine psi_sswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_real_swap_tag p2ptag = psb_real_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),n*nerv,& call mpi_irecv(rcvbuf(rcv_pt),n*nerv,&
@ -436,7 +436,7 @@ subroutine psi_sswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nesd>0) call psb_snd(ictxt,& if (nesd>0) call psb_snd(ctxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
rcv_pt = rcv_pt + n*nerv rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd snd_pt = snd_pt + n*nesd
@ -453,7 +453,7 @@ subroutine psi_sswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nerv>0) call psb_rcv(ictxt,& if (nerv>0) call psb_rcv(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
rcv_pt = rcv_pt + n*nerv rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd snd_pt = snd_pt + n*nesd
@ -501,7 +501,7 @@ subroutine psi_sswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_sswapidxm end subroutine psi_sswapidxm
@ -582,7 +582,7 @@ subroutine psi_sswapdatav(flag,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act
integer(psb_ipk_), pointer :: d_idx(:) integer(psb_ipk_), pointer :: d_idx(:)
@ -592,9 +592,9 @@ subroutine psi_sswapdatav(flag,beta,y,desc_a,work,info,data)
name='psi_swap_datav' name='psi_swap_datav'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -619,13 +619,13 @@ subroutine psi_sswapdatav(flag,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swapdata(ictxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) call psi_swapdata(ctxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_sswapdatav end subroutine psi_sswapdatav
@ -641,7 +641,7 @@ end subroutine psi_sswapdatav
! !
! !
! !
subroutine psi_sswapidxv(iictxt,iicomm,flag,beta,y,idx, & subroutine psi_sswapidxv(ictxt,iicomm,flag,beta,y,idx, &
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_sswapidxv use psi_mod, psb_protect_name => psi_sswapidxv
@ -656,7 +656,7 @@ subroutine psi_sswapidxv(iictxt,iicomm,flag,beta,y,idx, &
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: iictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: iicomm integer(psb_mpk_), intent(in) :: iicomm
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -665,7 +665,7 @@ subroutine psi_sswapidxv(iictxt,iicomm,flag,beta,y,idx, &
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm, np, me,& integer(psb_mpk_) :: icomm, np, me,&
& proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
@ -684,10 +684,10 @@ subroutine psi_sswapidxv(iictxt,iicomm,flag,beta,y,idx, &
info=psb_success_ info=psb_success_
name='psi_swap_datav' name='psi_swap_datav'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = iictxt ctxt = ictxt
icomm = iicomm icomm = iicomm
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -727,7 +727,7 @@ subroutine psi_sswapidxv(iictxt,iicomm,flag,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm)
brvidx(proc_to_comm) = rcv_pt brvidx(proc_to_comm) = rcv_pt
rvsz(proc_to_comm) = nerv rvsz(proc_to_comm) = nerv
@ -807,14 +807,14 @@ subroutine psi_sswapidxv(iictxt,iicomm,flag,beta,y,idx, &
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (proc_to_comm < me) then if (proc_to_comm < me) then
if (nesd>0) call psb_snd(ictxt,& if (nesd>0) call psb_snd(ctxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
if (nerv>0) call psb_rcv(ictxt,& if (nerv>0) call psb_rcv(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
else if (proc_to_comm > me) then else if (proc_to_comm > me) then
if (nerv>0) call psb_rcv(ictxt,& if (nerv>0) call psb_rcv(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
if (nesd>0) call psb_snd(ictxt,& if (nesd>0) call psb_snd(ctxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
else if (proc_to_comm == me) then else if (proc_to_comm == me) then
if (nesd /= nerv) then if (nesd /= nerv) then
@ -841,7 +841,7 @@ subroutine psi_sswapidxv(iictxt,iicomm,flag,beta,y,idx, &
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_real_swap_tag p2ptag = psb_real_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),nerv,& call mpi_irecv(rcvbuf(rcv_pt),nerv,&
@ -925,7 +925,7 @@ subroutine psi_sswapidxv(iictxt,iicomm,flag,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nesd>0) call psb_snd(ictxt,& if (nesd>0) call psb_snd(ctxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd snd_pt = snd_pt + nesd
@ -941,7 +941,7 @@ subroutine psi_sswapidxv(iictxt,iicomm,flag,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nerv>0) call psb_rcv(ictxt,& if (nerv>0) call psb_rcv(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd snd_pt = snd_pt + nesd
@ -988,7 +988,7 @@ subroutine psi_sswapidxv(iictxt,iicomm,flag,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_sswapidxv end subroutine psi_sswapidxv

48
base/comm/internals/psi_sswaptran.F90
Unescape Escape View File

@ -115,7 +115,7 @@ subroutine psi_sswaptran_vect(flag,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_
class(psb_i_base_vect_type), pointer :: d_vidx class(psb_i_base_vect_type), pointer :: d_vidx
@ -125,9 +125,9 @@ subroutine psi_sswaptran_vect(flag,beta,y,desc_a,work,info,data)
name='psi_swap_tranv' name='psi_swap_tranv'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -152,13 +152,13 @@ subroutine psi_sswaptran_vect(flag,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swaptran(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) call psi_swaptran(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_sswaptran_vect end subroutine psi_sswaptran_vect
@ -176,7 +176,7 @@ end subroutine psi_sswaptran_vect
! !
! !
! !
subroutine psi_stran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& subroutine psi_stran_vidx_vect(ictxt,iicomm,flag,beta,y,idx,&
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_stran_vidx_vect use psi_mod, psb_protect_name => psi_stran_vidx_vect
@ -193,7 +193,7 @@ subroutine psi_stran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: iictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: iicomm integer(psb_mpk_), intent(in) :: iicomm
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -204,7 +204,7 @@ subroutine psi_stran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm, np, me,& integer(psb_mpk_) :: icomm, np, me,&
& proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable :: prcid(:) integer(psb_mpk_), allocatable :: prcid(:)
@ -219,10 +219,10 @@ subroutine psi_stran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
info=psb_success_ info=psb_success_
name='psi_swap_tran' name='psi_swap_tran'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = iictxt ctxt = ictxt
icomm = iicomm icomm = iicomm
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -269,7 +269,7 @@ subroutine psi_stran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
snd_pt = 1+pnti+nerv+psb_n_elem_send_ snd_pt = 1+pnti+nerv+psb_n_elem_send_
rcv_pt = 1+pnti+psb_n_elem_recv_ rcv_pt = 1+pnti+psb_n_elem_recv_
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt
call mpi_irecv(y%combuf(snd_pt),nesd,& call mpi_irecv(y%combuf(snd_pt),nesd,&
@ -425,7 +425,7 @@ subroutine psi_stran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
@ -466,7 +466,7 @@ subroutine psi_sswaptran_multivect(flag,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_
class(psb_i_base_vect_type), pointer :: d_vidx class(psb_i_base_vect_type), pointer :: d_vidx
@ -476,9 +476,9 @@ subroutine psi_sswaptran_multivect(flag,beta,y,desc_a,work,info,data)
name='psi_swap_tranv' name='psi_swap_tranv'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -503,13 +503,13 @@ subroutine psi_sswaptran_multivect(flag,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swaptran(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) call psi_swaptran(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_sswaptran_multivect end subroutine psi_sswaptran_multivect
@ -528,7 +528,7 @@ subroutine psi_sswaptran_multivect(flag,beta,y,desc_a,work,info,data)
! !
! !
! !
subroutine psi_stran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& subroutine psi_stran_vidx_multivect(ictxt,iicomm,flag,beta,y,idx,&
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_stran_vidx_multivect use psi_mod, psb_protect_name => psi_stran_vidx_multivect
@ -545,7 +545,7 @@ subroutine psi_stran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: iictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: iicomm integer(psb_mpk_), intent(in) :: iicomm
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -556,7 +556,7 @@ subroutine psi_stran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm, np, me,& integer(psb_mpk_) :: icomm, np, me,&
& proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable :: prcid(:) integer(psb_mpk_), allocatable :: prcid(:)
@ -571,10 +571,10 @@ subroutine psi_stran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
info=psb_success_ info=psb_success_
name='psi_swap_tran' name='psi_swap_tran'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = iictxt ctxt = ictxt
icomm = iicomm icomm = iicomm
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -621,7 +621,7 @@ subroutine psi_stran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
proc_to_comm = idx%v(pnti+psb_proc_id_) proc_to_comm = idx%v(pnti+psb_proc_id_)
nerv = idx%v(pnti+psb_n_elem_recv_) nerv = idx%v(pnti+psb_n_elem_recv_)
nesd = idx%v(pnti+nerv+psb_n_elem_send_) nesd = idx%v(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
if (debug) write(*,*) me,'Posting receive from',prcid(i),snd_pt if (debug) write(*,*) me,'Posting receive from',prcid(i),snd_pt
call mpi_irecv(y%combuf(snd_pt),n*nesd,& call mpi_irecv(y%combuf(snd_pt),n*nesd,&
@ -781,7 +781,7 @@ subroutine psi_stran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return

76
base/comm/internals/psi_sswaptran_a.F90
Unescape Escape View File

@ -110,7 +110,7 @@ subroutine psi_sswaptranm(flag,n,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, err_act, totxch, data_ integer(psb_ipk_) :: np, me, idxs, idxr, err_act, totxch, data_
integer(psb_ipk_), pointer :: d_idx(:) integer(psb_ipk_), pointer :: d_idx(:)
@ -120,10 +120,10 @@ subroutine psi_sswaptranm(flag,n,beta,y,desc_a,work,info,data)
name='psi_swap_tran' name='psi_swap_tran'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -148,18 +148,18 @@ subroutine psi_sswaptranm(flag,n,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swaptran(ictxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info) call psi_swaptran(ctxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_sswaptranm end subroutine psi_sswaptranm
subroutine psi_stranidxm(iictxt,iicomm,flag,n,beta,y,idx,& subroutine psi_stranidxm(ictxt,iicomm,flag,n,beta,y,idx,&
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_stranidxm use psi_mod, psb_protect_name => psi_stranidxm
@ -174,7 +174,7 @@ subroutine psi_stranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: iictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: iicomm integer(psb_mpk_), intent(in) :: iicomm
integer(psb_ipk_), intent(in) :: flag,n integer(psb_ipk_), intent(in) :: flag,n
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -183,7 +183,7 @@ subroutine psi_stranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm, np, me,& integer(psb_mpk_) :: icomm, np, me,&
& proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
@ -202,10 +202,10 @@ subroutine psi_stranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
info=psb_success_ info=psb_success_
name='psi_swap_tran' name='psi_swap_tran'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = iictxt ctxt = ictxt
icomm = iicomm icomm = iicomm
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -245,7 +245,7 @@ subroutine psi_stranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm)
brvidx(proc_to_comm) = rcv_pt brvidx(proc_to_comm) = rcv_pt
rvsz(proc_to_comm) = n*nerv rvsz(proc_to_comm) = n*nerv
@ -329,14 +329,14 @@ subroutine psi_stranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (proc_to_comm < me) then if (proc_to_comm < me) then
if (nerv>0) call psb_snd(ictxt,& if (nerv>0) call psb_snd(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
if (nesd>0) call psb_rcv(ictxt,& if (nesd>0) call psb_rcv(ctxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
else if (proc_to_comm > me) then else if (proc_to_comm > me) then
if (nesd>0) call psb_rcv(ictxt,& if (nesd>0) call psb_rcv(ctxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
if (nerv>0) call psb_snd(ictxt,& if (nerv>0) call psb_snd(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
else if (proc_to_comm == me) then else if (proc_to_comm == me) then
if (nesd /= nerv) then if (nesd /= nerv) then
@ -363,7 +363,7 @@ subroutine psi_stranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
p2ptag = psb_real_swap_tag p2ptag = psb_real_swap_tag
call mpi_irecv(sndbuf(snd_pt),n*nesd,& call mpi_irecv(sndbuf(snd_pt),n*nesd,&
@ -448,7 +448,7 @@ subroutine psi_stranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nerv>0) call psb_snd(ictxt,& if (nerv>0) call psb_snd(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
rcv_pt = rcv_pt + n*nerv rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd snd_pt = snd_pt + n*nesd
@ -465,7 +465,7 @@ subroutine psi_stranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nesd>0) call psb_rcv(ictxt,& if (nesd>0) call psb_rcv(ctxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
rcv_pt = rcv_pt + n*nerv rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd snd_pt = snd_pt + n*nesd
@ -513,7 +513,7 @@ subroutine psi_stranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_stranidxm end subroutine psi_stranidxm
@ -597,7 +597,7 @@ subroutine psi_sswaptranv(flag,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_
integer(psb_ipk_), pointer :: d_idx(:) integer(psb_ipk_), pointer :: d_idx(:)
@ -607,9 +607,9 @@ subroutine psi_sswaptranv(flag,beta,y,desc_a,work,info,data)
name='psi_swap_tranv' name='psi_swap_tranv'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -634,13 +634,13 @@ subroutine psi_sswaptranv(flag,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swaptran(ictxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) call psi_swaptran(ctxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_sswaptranv end subroutine psi_sswaptranv
@ -656,7 +656,7 @@ end subroutine psi_sswaptranv
! !
! !
! !
subroutine psi_stranidxv(iictxt,iicomm,flag,beta,y,idx,& subroutine psi_stranidxv(ictxt,iicomm,flag,beta,y,idx,&
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_stranidxv use psi_mod, psb_protect_name => psi_stranidxv
@ -671,7 +671,7 @@ subroutine psi_stranidxv(iictxt,iicomm,flag,beta,y,idx,&
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: iictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: iicomm integer(psb_mpk_), intent(in) :: iicomm
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -680,7 +680,7 @@ subroutine psi_stranidxv(iictxt,iicomm,flag,beta,y,idx,&
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm, np, me,& integer(psb_mpk_) :: icomm, np, me,&
& proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
@ -699,10 +699,10 @@ subroutine psi_stranidxv(iictxt,iicomm,flag,beta,y,idx,&
info=psb_success_ info=psb_success_
name='psi_swap_tran' name='psi_swap_tran'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = iictxt ctxt = ictxt
icomm = iicomm icomm = iicomm
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -742,7 +742,7 @@ subroutine psi_stranidxv(iictxt,iicomm,flag,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm)
brvidx(proc_to_comm) = rcv_pt brvidx(proc_to_comm) = rcv_pt
rvsz(proc_to_comm) = nerv rvsz(proc_to_comm) = nerv
@ -827,14 +827,14 @@ subroutine psi_stranidxv(iictxt,iicomm,flag,beta,y,idx,&
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (proc_to_comm < me) then if (proc_to_comm < me) then
if (nerv>0) call psb_snd(ictxt,& if (nerv>0) call psb_snd(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
if (nesd>0) call psb_rcv(ictxt,& if (nesd>0) call psb_rcv(ctxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
else if (proc_to_comm > me) then else if (proc_to_comm > me) then
if (nesd>0) call psb_rcv(ictxt,& if (nesd>0) call psb_rcv(ctxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
if (nerv>0) call psb_snd(ictxt,& if (nerv>0) call psb_snd(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
else if (proc_to_comm == me) then else if (proc_to_comm == me) then
if (nesd /= nerv) then if (nesd /= nerv) then
@ -860,7 +860,7 @@ subroutine psi_stranidxv(iictxt,iicomm,flag,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
p2ptag = psb_real_swap_tag p2ptag = psb_real_swap_tag
call mpi_irecv(sndbuf(snd_pt),nesd,& call mpi_irecv(sndbuf(snd_pt),nesd,&
@ -943,7 +943,7 @@ subroutine psi_stranidxv(iictxt,iicomm,flag,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nerv>0) call psb_snd(ictxt,& if (nerv>0) call psb_snd(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd snd_pt = snd_pt + nesd
@ -959,7 +959,7 @@ subroutine psi_stranidxv(iictxt,iicomm,flag,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nesd>0) call psb_rcv(ictxt,& if (nesd>0) call psb_rcv(ctxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd snd_pt = snd_pt + nesd
@ -1006,7 +1006,7 @@ subroutine psi_stranidxv(iictxt,iicomm,flag,beta,y,idx,&
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_stranidxv end subroutine psi_stranidxv

16
base/comm/internals/psi_zovrl_restr.f90
Unescape Escape View File

@ -47,7 +47,7 @@ subroutine psi_zovrl_restr_vect(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz integer(psb_ipk_) :: np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -57,8 +57,8 @@ subroutine psi_zovrl_restr_vect(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -72,7 +72,7 @@ subroutine psi_zovrl_restr_vect(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_zovrl_restr_vect end subroutine psi_zovrl_restr_vect
@ -90,7 +90,7 @@ subroutine psi_zovrl_restr_multivect(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -100,8 +100,8 @@ subroutine psi_zovrl_restr_multivect(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -114,7 +114,7 @@ subroutine psi_zovrl_restr_multivect(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_zovrl_restr_multivect end subroutine psi_zovrl_restr_multivect

16
base/comm/internals/psi_zovrl_restr_a.f90
Unescape Escape View File

@ -45,7 +45,7 @@ subroutine psi_zovrl_restrr1(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz integer(psb_ipk_) :: np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -55,8 +55,8 @@ subroutine psi_zovrl_restrr1(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -73,7 +73,7 @@ subroutine psi_zovrl_restrr1(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_zovrl_restrr1 end subroutine psi_zovrl_restrr1
@ -89,7 +89,7 @@ subroutine psi_zovrl_restrr2(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz integer(psb_ipk_) :: np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -99,8 +99,8 @@ subroutine psi_zovrl_restrr2(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -124,7 +124,7 @@ subroutine psi_zovrl_restrr2(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_zovrl_restrr2 end subroutine psi_zovrl_restrr2

16
base/comm/internals/psi_zovrl_save.f90
Unescape Escape View File

@ -47,7 +47,7 @@ subroutine psi_zovrl_save_vect(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz integer(psb_ipk_) :: np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -57,8 +57,8 @@ subroutine psi_zovrl_save_vect(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -78,7 +78,7 @@ subroutine psi_zovrl_save_vect(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_zovrl_save_vect end subroutine psi_zovrl_save_vect
@ -96,7 +96,7 @@ subroutine psi_zovrl_save_multivect(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -106,8 +106,8 @@ subroutine psi_zovrl_save_multivect(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -128,7 +128,7 @@ subroutine psi_zovrl_save_multivect(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_zovrl_save_multivect end subroutine psi_zovrl_save_multivect

16
base/comm/internals/psi_zovrl_save_a.f90
Unescape Escape View File

@ -47,7 +47,7 @@ subroutine psi_zovrl_saver1(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz integer(psb_ipk_) :: np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -57,8 +57,8 @@ subroutine psi_zovrl_saver1(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -81,7 +81,7 @@ subroutine psi_zovrl_saver1(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_zovrl_saver1 end subroutine psi_zovrl_saver1
@ -100,7 +100,7 @@ subroutine psi_zovrl_saver2(x,xs,desc_a,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -110,8 +110,8 @@ subroutine psi_zovrl_saver2(x,xs,desc_a,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -135,7 +135,7 @@ subroutine psi_zovrl_saver2(x,xs,desc_a,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_zovrl_saver2 end subroutine psi_zovrl_saver2

16
base/comm/internals/psi_zovrl_upd.f90
Unescape Escape View File

@ -50,7 +50,7 @@ subroutine psi_zovrl_upd_vect(x,desc_a,update,info)
! locals ! locals
complex(psb_dpk_), allocatable :: xs(:) complex(psb_dpk_), allocatable :: xs(:)
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -62,8 +62,8 @@ subroutine psi_zovrl_upd_vect(x,desc_a,update,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -113,7 +113,7 @@ subroutine psi_zovrl_upd_vect(x,desc_a,update,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_zovrl_upd_vect end subroutine psi_zovrl_upd_vect
@ -132,7 +132,7 @@ subroutine psi_zovrl_upd_multivect(x,desc_a,update,info)
! locals ! locals
complex(psb_dpk_), allocatable :: xs(:,:) complex(psb_dpk_), allocatable :: xs(:,:)
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx, nc integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx, nc
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -144,8 +144,8 @@ subroutine psi_zovrl_upd_multivect(x,desc_a,update,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -196,7 +196,7 @@ subroutine psi_zovrl_upd_multivect(x,desc_a,update,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_zovrl_upd_multivect end subroutine psi_zovrl_upd_multivect

16
base/comm/internals/psi_zovrl_upd_a.f90
Unescape Escape View File

@ -46,7 +46,7 @@ subroutine psi_zovrl_updr1(x,desc_a,update,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, ndm integer(psb_ipk_) :: np, me, err_act, i, idx, ndm
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -57,8 +57,8 @@ subroutine psi_zovrl_updr1(x,desc_a,update,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -99,7 +99,7 @@ subroutine psi_zovrl_updr1(x,desc_a,update,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_zovrl_updr1 end subroutine psi_zovrl_updr1
@ -115,7 +115,7 @@ subroutine psi_zovrl_updr2(x,desc_a,update,info)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, i, idx, ndm integer(psb_ipk_) :: np, me, err_act, i, idx, ndm
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -126,8 +126,8 @@ subroutine psi_zovrl_updr2(x,desc_a,update,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -168,7 +168,7 @@ subroutine psi_zovrl_updr2(x,desc_a,update,info)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_zovrl_updr2 end subroutine psi_zovrl_updr2

48
base/comm/internals/psi_zswapdata.F90
Unescape Escape View File

@ -113,7 +113,7 @@ subroutine psi_zswapdata_vect(flag,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act
class(psb_i_base_vect_type), pointer :: d_vidx class(psb_i_base_vect_type), pointer :: d_vidx
@ -123,9 +123,9 @@ subroutine psi_zswapdata_vect(flag,beta,y,desc_a,work,info,data)
name='psi_swap_datav' name='psi_swap_datav'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -150,13 +150,13 @@ subroutine psi_zswapdata_vect(flag,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swapdata(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) call psi_swapdata(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_zswapdata_vect end subroutine psi_zswapdata_vect
@ -175,7 +175,7 @@ end subroutine psi_zswapdata_vect
! !
! !
! !
subroutine psi_zswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & subroutine psi_zswap_vidx_vect(ictxt,iicomm,flag,beta,y,idx, &
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_zswap_vidx_vect use psi_mod, psb_protect_name => psi_zswap_vidx_vect
@ -192,7 +192,7 @@ subroutine psi_zswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: iictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: iicomm integer(psb_mpk_), intent(in) :: iicomm
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -203,7 +203,7 @@ subroutine psi_zswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm, np, me,& integer(psb_mpk_) :: icomm, np, me,&
& proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable :: prcid(:) integer(psb_mpk_), allocatable :: prcid(:)
@ -218,10 +218,10 @@ subroutine psi_zswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
info=psb_success_ info=psb_success_
name='psi_swap_datav' name='psi_swap_datav'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = iictxt ctxt = ictxt
icomm = iicomm icomm = iicomm
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -265,7 +265,7 @@ subroutine psi_zswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
nesd = idx%v(pnti+nerv+psb_n_elem_send_) nesd = idx%v(pnti+nerv+psb_n_elem_send_)
rcv_pt = 1+pnti+psb_n_elem_recv_ rcv_pt = 1+pnti+psb_n_elem_recv_
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt
p2ptag = psb_dcomplex_swap_tag p2ptag = psb_dcomplex_swap_tag
@ -418,7 +418,7 @@ subroutine psi_zswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_zswap_vidx_vect end subroutine psi_zswap_vidx_vect
@ -455,7 +455,7 @@ subroutine psi_zswapdata_multivect(flag,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act
class(psb_i_base_vect_type), pointer :: d_vidx class(psb_i_base_vect_type), pointer :: d_vidx
@ -465,9 +465,9 @@ subroutine psi_zswapdata_multivect(flag,beta,y,desc_a,work,info,data)
name='psi_swap_datav' name='psi_swap_datav'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -492,13 +492,13 @@ subroutine psi_zswapdata_multivect(flag,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swapdata(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) call psi_swapdata(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_zswapdata_multivect end subroutine psi_zswapdata_multivect
@ -517,7 +517,7 @@ end subroutine psi_zswapdata_multivect
! !
! !
! !
subroutine psi_zswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & subroutine psi_zswap_vidx_multivect(ictxt,iicomm,flag,beta,y,idx, &
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_zswap_vidx_multivect use psi_mod, psb_protect_name => psi_zswap_vidx_multivect
@ -534,7 +534,7 @@ subroutine psi_zswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: iictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: iicomm integer(psb_mpk_), intent(in) :: iicomm
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -545,7 +545,7 @@ subroutine psi_zswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm, np, me,& integer(psb_mpk_) :: icomm, np, me,&
& proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable :: prcid(:) integer(psb_mpk_), allocatable :: prcid(:)
@ -560,10 +560,10 @@ subroutine psi_zswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
info=psb_success_ info=psb_success_
name='psi_swap_datav' name='psi_swap_datav'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = iictxt ctxt = ictxt
icomm = iicomm icomm = iicomm
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -609,7 +609,7 @@ subroutine psi_zswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
proc_to_comm = idx%v(pnti+psb_proc_id_) proc_to_comm = idx%v(pnti+psb_proc_id_)
nerv = idx%v(pnti+psb_n_elem_recv_) nerv = idx%v(pnti+psb_n_elem_recv_)
nesd = idx%v(pnti+nerv+psb_n_elem_send_) nesd = idx%v(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt
p2ptag = psb_dcomplex_swap_tag p2ptag = psb_dcomplex_swap_tag
@ -766,7 +766,7 @@ subroutine psi_zswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_zswap_vidx_multivect end subroutine psi_zswap_vidx_multivect

72
base/comm/internals/psi_zswapdata_a.F90
Unescape Escape View File

@ -106,7 +106,7 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act
integer(psb_ipk_), pointer :: d_idx(:) integer(psb_ipk_), pointer :: d_idx(:)
@ -116,9 +116,9 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data)
name='psi_swap_data' name='psi_swap_data'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -143,18 +143,18 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swapdata(ictxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info) call psi_swapdata(ctxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_zswapdatam end subroutine psi_zswapdatam
subroutine psi_zswapidxm(ictxt,icomm,flag,n,beta,y,idx, & subroutine psi_zswapidxm(ctxt,icomm,flag,n,beta,y,idx, &
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_zswapidxm use psi_mod, psb_protect_name => psi_zswapidxm
@ -169,7 +169,7 @@ subroutine psi_zswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: ictxt type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(in) :: icomm integer(psb_mpk_), intent(in) :: icomm
integer(psb_ipk_), intent(in) :: flag,n integer(psb_ipk_), intent(in) :: flag,n
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -198,7 +198,7 @@ subroutine psi_zswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
name='psi_swap_data' name='psi_swap_data'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -238,7 +238,7 @@ subroutine psi_zswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm)
brvidx(proc_to_comm) = rcv_pt brvidx(proc_to_comm) = rcv_pt
rvsz(proc_to_comm) = n*nerv rvsz(proc_to_comm) = n*nerv
@ -317,14 +317,14 @@ subroutine psi_zswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (proc_to_comm < me) then if (proc_to_comm < me) then
if (nesd>0) call psb_snd(ictxt,& if (nesd>0) call psb_snd(ctxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
if (nerv>0) call psb_rcv(ictxt,& if (nerv>0) call psb_rcv(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
else if (proc_to_comm > me) then else if (proc_to_comm > me) then
if (nerv>0) call psb_rcv(ictxt,& if (nerv>0) call psb_rcv(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
if (nesd>0) call psb_snd(ictxt,& if (nesd>0) call psb_snd(ctxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
else if (proc_to_comm == me) then else if (proc_to_comm == me) then
if (nesd /= nerv) then if (nesd /= nerv) then
@ -351,7 +351,7 @@ subroutine psi_zswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_dcomplex_swap_tag p2ptag = psb_dcomplex_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),n*nerv,& call mpi_irecv(rcvbuf(rcv_pt),n*nerv,&
@ -436,7 +436,7 @@ subroutine psi_zswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nesd>0) call psb_snd(ictxt,& if (nesd>0) call psb_snd(ctxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
rcv_pt = rcv_pt + n*nerv rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd snd_pt = snd_pt + n*nesd
@ -453,7 +453,7 @@ subroutine psi_zswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nerv>0) call psb_rcv(ictxt,& if (nerv>0) call psb_rcv(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
rcv_pt = rcv_pt + n*nerv rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd snd_pt = snd_pt + n*nesd
@ -501,7 +501,7 @@ subroutine psi_zswapidxm(ictxt,icomm,flag,n,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_zswapidxm end subroutine psi_zswapidxm
@ -582,7 +582,7 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act
integer(psb_ipk_), pointer :: d_idx(:) integer(psb_ipk_), pointer :: d_idx(:)
@ -592,9 +592,9 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data)
name='psi_swap_datav' name='psi_swap_datav'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -619,13 +619,13 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swapdata(ictxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) call psi_swapdata(ctxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_zswapdatav end subroutine psi_zswapdatav
@ -641,7 +641,7 @@ end subroutine psi_zswapdatav
! !
! !
! !
subroutine psi_zswapidxv(iictxt,iicomm,flag,beta,y,idx, & subroutine psi_zswapidxv(ictxt,iicomm,flag,beta,y,idx, &
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_zswapidxv use psi_mod, psb_protect_name => psi_zswapidxv
@ -656,7 +656,7 @@ subroutine psi_zswapidxv(iictxt,iicomm,flag,beta,y,idx, &
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: iictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: iicomm integer(psb_mpk_), intent(in) :: iicomm
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -665,7 +665,7 @@ subroutine psi_zswapidxv(iictxt,iicomm,flag,beta,y,idx, &
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm, np, me,& integer(psb_mpk_) :: icomm, np, me,&
& proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
@ -684,10 +684,10 @@ subroutine psi_zswapidxv(iictxt,iicomm,flag,beta,y,idx, &
info=psb_success_ info=psb_success_
name='psi_swap_datav' name='psi_swap_datav'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = iictxt ctxt = ictxt
icomm = iicomm icomm = iicomm
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -727,7 +727,7 @@ subroutine psi_zswapidxv(iictxt,iicomm,flag,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm)
brvidx(proc_to_comm) = rcv_pt brvidx(proc_to_comm) = rcv_pt
rvsz(proc_to_comm) = nerv rvsz(proc_to_comm) = nerv
@ -807,14 +807,14 @@ subroutine psi_zswapidxv(iictxt,iicomm,flag,beta,y,idx, &
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (proc_to_comm < me) then if (proc_to_comm < me) then
if (nesd>0) call psb_snd(ictxt,& if (nesd>0) call psb_snd(ctxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
if (nerv>0) call psb_rcv(ictxt,& if (nerv>0) call psb_rcv(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
else if (proc_to_comm > me) then else if (proc_to_comm > me) then
if (nerv>0) call psb_rcv(ictxt,& if (nerv>0) call psb_rcv(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
if (nesd>0) call psb_snd(ictxt,& if (nesd>0) call psb_snd(ctxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
else if (proc_to_comm == me) then else if (proc_to_comm == me) then
if (nesd /= nerv) then if (nesd /= nerv) then
@ -841,7 +841,7 @@ subroutine psi_zswapidxv(iictxt,iicomm,flag,beta,y,idx, &
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = psb_dcomplex_swap_tag p2ptag = psb_dcomplex_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),nerv,& call mpi_irecv(rcvbuf(rcv_pt),nerv,&
@ -925,7 +925,7 @@ subroutine psi_zswapidxv(iictxt,iicomm,flag,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nesd>0) call psb_snd(ictxt,& if (nesd>0) call psb_snd(ctxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd snd_pt = snd_pt + nesd
@ -941,7 +941,7 @@ subroutine psi_zswapidxv(iictxt,iicomm,flag,beta,y,idx, &
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nerv>0) call psb_rcv(ictxt,& if (nerv>0) call psb_rcv(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd snd_pt = snd_pt + nesd
@ -988,7 +988,7 @@ subroutine psi_zswapidxv(iictxt,iicomm,flag,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_zswapidxv end subroutine psi_zswapidxv

48
base/comm/internals/psi_zswaptran.F90
Unescape Escape View File

@ -115,7 +115,7 @@ subroutine psi_zswaptran_vect(flag,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_
class(psb_i_base_vect_type), pointer :: d_vidx class(psb_i_base_vect_type), pointer :: d_vidx
@ -125,9 +125,9 @@ subroutine psi_zswaptran_vect(flag,beta,y,desc_a,work,info,data)
name='psi_swap_tranv' name='psi_swap_tranv'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -152,13 +152,13 @@ subroutine psi_zswaptran_vect(flag,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swaptran(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) call psi_swaptran(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_zswaptran_vect end subroutine psi_zswaptran_vect
@ -176,7 +176,7 @@ end subroutine psi_zswaptran_vect
! !
! !
! !
subroutine psi_ztran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& subroutine psi_ztran_vidx_vect(ictxt,iicomm,flag,beta,y,idx,&
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_ztran_vidx_vect use psi_mod, psb_protect_name => psi_ztran_vidx_vect
@ -193,7 +193,7 @@ subroutine psi_ztran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: iictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: iicomm integer(psb_mpk_), intent(in) :: iicomm
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -204,7 +204,7 @@ subroutine psi_ztran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm, np, me,& integer(psb_mpk_) :: icomm, np, me,&
& proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable :: prcid(:) integer(psb_mpk_), allocatable :: prcid(:)
@ -219,10 +219,10 @@ subroutine psi_ztran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
info=psb_success_ info=psb_success_
name='psi_swap_tran' name='psi_swap_tran'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = iictxt ctxt = ictxt
icomm = iicomm icomm = iicomm
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -269,7 +269,7 @@ subroutine psi_ztran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
snd_pt = 1+pnti+nerv+psb_n_elem_send_ snd_pt = 1+pnti+nerv+psb_n_elem_send_
rcv_pt = 1+pnti+psb_n_elem_recv_ rcv_pt = 1+pnti+psb_n_elem_recv_
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt
call mpi_irecv(y%combuf(snd_pt),nesd,& call mpi_irecv(y%combuf(snd_pt),nesd,&
@ -425,7 +425,7 @@ subroutine psi_ztran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
@ -466,7 +466,7 @@ subroutine psi_zswaptran_multivect(flag,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_
class(psb_i_base_vect_type), pointer :: d_vidx class(psb_i_base_vect_type), pointer :: d_vidx
@ -476,9 +476,9 @@ subroutine psi_zswaptran_multivect(flag,beta,y,desc_a,work,info,data)
name='psi_swap_tranv' name='psi_swap_tranv'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -503,13 +503,13 @@ subroutine psi_zswaptran_multivect(flag,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swaptran(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) call psi_swaptran(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_zswaptran_multivect end subroutine psi_zswaptran_multivect
@ -528,7 +528,7 @@ subroutine psi_zswaptran_multivect(flag,beta,y,desc_a,work,info,data)
! !
! !
! !
subroutine psi_ztran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& subroutine psi_ztran_vidx_multivect(ictxt,iicomm,flag,beta,y,idx,&
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_ztran_vidx_multivect use psi_mod, psb_protect_name => psi_ztran_vidx_multivect
@ -545,7 +545,7 @@ subroutine psi_ztran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: iictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: iicomm integer(psb_mpk_), intent(in) :: iicomm
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -556,7 +556,7 @@ subroutine psi_ztran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm, np, me,& integer(psb_mpk_) :: icomm, np, me,&
& proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable :: prcid(:) integer(psb_mpk_), allocatable :: prcid(:)
@ -571,10 +571,10 @@ subroutine psi_ztran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
info=psb_success_ info=psb_success_
name='psi_swap_tran' name='psi_swap_tran'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = iictxt ctxt = ictxt
icomm = iicomm icomm = iicomm
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -621,7 +621,7 @@ subroutine psi_ztran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
proc_to_comm = idx%v(pnti+psb_proc_id_) proc_to_comm = idx%v(pnti+psb_proc_id_)
nerv = idx%v(pnti+psb_n_elem_recv_) nerv = idx%v(pnti+psb_n_elem_recv_)
nesd = idx%v(pnti+nerv+psb_n_elem_send_) nesd = idx%v(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
if (debug) write(*,*) me,'Posting receive from',prcid(i),snd_pt if (debug) write(*,*) me,'Posting receive from',prcid(i),snd_pt
call mpi_irecv(y%combuf(snd_pt),n*nesd,& call mpi_irecv(y%combuf(snd_pt),n*nesd,&
@ -781,7 +781,7 @@ subroutine psi_ztran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return

76
base/comm/internals/psi_zswaptran_a.F90
Unescape Escape View File

@ -110,7 +110,7 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, err_act, totxch, data_ integer(psb_ipk_) :: np, me, idxs, idxr, err_act, totxch, data_
integer(psb_ipk_), pointer :: d_idx(:) integer(psb_ipk_), pointer :: d_idx(:)
@ -120,10 +120,10 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
name='psi_swap_tran' name='psi_swap_tran'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -148,18 +148,18 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swaptran(ictxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info) call psi_swaptran(ctxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_zswaptranm end subroutine psi_zswaptranm
subroutine psi_ztranidxm(iictxt,iicomm,flag,n,beta,y,idx,& subroutine psi_ztranidxm(ictxt,iicomm,flag,n,beta,y,idx,&
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_ztranidxm use psi_mod, psb_protect_name => psi_ztranidxm
@ -174,7 +174,7 @@ subroutine psi_ztranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: iictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: iicomm integer(psb_mpk_), intent(in) :: iicomm
integer(psb_ipk_), intent(in) :: flag,n integer(psb_ipk_), intent(in) :: flag,n
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -183,7 +183,7 @@ subroutine psi_ztranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm, np, me,& integer(psb_mpk_) :: icomm, np, me,&
& proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
@ -202,10 +202,10 @@ subroutine psi_ztranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
info=psb_success_ info=psb_success_
name='psi_swap_tran' name='psi_swap_tran'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = iictxt ctxt = ictxt
icomm = iicomm icomm = iicomm
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -245,7 +245,7 @@ subroutine psi_ztranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm)
brvidx(proc_to_comm) = rcv_pt brvidx(proc_to_comm) = rcv_pt
rvsz(proc_to_comm) = n*nerv rvsz(proc_to_comm) = n*nerv
@ -329,14 +329,14 @@ subroutine psi_ztranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (proc_to_comm < me) then if (proc_to_comm < me) then
if (nerv>0) call psb_snd(ictxt,& if (nerv>0) call psb_snd(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
if (nesd>0) call psb_rcv(ictxt,& if (nesd>0) call psb_rcv(ctxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
else if (proc_to_comm > me) then else if (proc_to_comm > me) then
if (nesd>0) call psb_rcv(ictxt,& if (nesd>0) call psb_rcv(ctxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
if (nerv>0) call psb_snd(ictxt,& if (nerv>0) call psb_snd(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
else if (proc_to_comm == me) then else if (proc_to_comm == me) then
if (nesd /= nerv) then if (nesd /= nerv) then
@ -363,7 +363,7 @@ subroutine psi_ztranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
p2ptag = psb_dcomplex_swap_tag p2ptag = psb_dcomplex_swap_tag
call mpi_irecv(sndbuf(snd_pt),n*nesd,& call mpi_irecv(sndbuf(snd_pt),n*nesd,&
@ -448,7 +448,7 @@ subroutine psi_ztranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nerv>0) call psb_snd(ictxt,& if (nerv>0) call psb_snd(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
rcv_pt = rcv_pt + n*nerv rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd snd_pt = snd_pt + n*nesd
@ -465,7 +465,7 @@ subroutine psi_ztranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nesd>0) call psb_rcv(ictxt,& if (nesd>0) call psb_rcv(ctxt,&
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
rcv_pt = rcv_pt + n*nerv rcv_pt = rcv_pt + n*nerv
snd_pt = snd_pt + n*nesd snd_pt = snd_pt + n*nesd
@ -513,7 +513,7 @@ subroutine psi_ztranidxm(iictxt,iicomm,flag,n,beta,y,idx,&
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_ztranidxm end subroutine psi_ztranidxm
@ -597,7 +597,7 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data)
integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_
integer(psb_ipk_), pointer :: d_idx(:) integer(psb_ipk_), pointer :: d_idx(:)
@ -607,9 +607,9 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data)
name='psi_swap_tranv' name='psi_swap_tranv'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -634,13 +634,13 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data)
goto 9999 goto 9999
end if end if
call psi_swaptran(ictxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) call psi_swaptran(ctxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_zswaptranv end subroutine psi_zswaptranv
@ -656,7 +656,7 @@ end subroutine psi_zswaptranv
! !
! !
! !
subroutine psi_ztranidxv(iictxt,iicomm,flag,beta,y,idx,& subroutine psi_ztranidxv(ictxt,iicomm,flag,beta,y,idx,&
& totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_ztranidxv use psi_mod, psb_protect_name => psi_ztranidxv
@ -671,7 +671,7 @@ subroutine psi_ztranidxv(iictxt,iicomm,flag,beta,y,idx,&
include 'mpif.h' include 'mpif.h'
#endif #endif
type(psb_ctxt_type), intent(in) :: iictxt type(psb_ctxt_type), intent(in) :: ictxt
integer(psb_mpk_), intent(in) :: iicomm integer(psb_mpk_), intent(in) :: iicomm
integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -680,7 +680,7 @@ subroutine psi_ztranidxv(iictxt,iicomm,flag,beta,y,idx,&
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm, np, me,& integer(psb_mpk_) :: icomm, np, me,&
& proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,&
@ -699,10 +699,10 @@ subroutine psi_ztranidxv(iictxt,iicomm,flag,beta,y,idx,&
info=psb_success_ info=psb_success_
name='psi_swap_tran' name='psi_swap_tran'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt = iictxt ctxt = ictxt
icomm = iicomm icomm = iicomm
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (np == -1) then if (np == -1) then
info=psb_err_context_error_ info=psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -742,7 +742,7 @@ subroutine psi_ztranidxv(iictxt,iicomm,flag,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm)
brvidx(proc_to_comm) = rcv_pt brvidx(proc_to_comm) = rcv_pt
rvsz(proc_to_comm) = nerv rvsz(proc_to_comm) = nerv
@ -827,14 +827,14 @@ subroutine psi_ztranidxv(iictxt,iicomm,flag,beta,y,idx,&
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (proc_to_comm < me) then if (proc_to_comm < me) then
if (nerv>0) call psb_snd(ictxt,& if (nerv>0) call psb_snd(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
if (nesd>0) call psb_rcv(ictxt,& if (nesd>0) call psb_rcv(ctxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
else if (proc_to_comm > me) then else if (proc_to_comm > me) then
if (nesd>0) call psb_rcv(ictxt,& if (nesd>0) call psb_rcv(ctxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
if (nerv>0) call psb_snd(ictxt,& if (nerv>0) call psb_snd(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
else if (proc_to_comm == me) then else if (proc_to_comm == me) then
if (nesd /= nerv) then if (nesd /= nerv) then
@ -860,7 +860,7 @@ subroutine psi_ztranidxv(iictxt,iicomm,flag,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
p2ptag = psb_dcomplex_swap_tag p2ptag = psb_dcomplex_swap_tag
call mpi_irecv(sndbuf(snd_pt),nesd,& call mpi_irecv(sndbuf(snd_pt),nesd,&
@ -943,7 +943,7 @@ subroutine psi_ztranidxv(iictxt,iicomm,flag,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nerv>0) call psb_snd(ictxt,& if (nerv>0) call psb_snd(ctxt,&
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd snd_pt = snd_pt + nesd
@ -959,7 +959,7 @@ subroutine psi_ztranidxv(iictxt,iicomm,flag,beta,y,idx,&
proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
if (nesd>0) call psb_rcv(ictxt,& if (nesd>0) call psb_rcv(ctxt,&
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
snd_pt = snd_pt + nesd snd_pt = snd_pt + nesd
@ -1006,7 +1006,7 @@ subroutine psi_ztranidxv(iictxt,iicomm,flag,beta,y,idx,&
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psi_ztranidxv end subroutine psi_ztranidxv

20
base/comm/psb_cgather.f90
Unescape Escape View File

@ -57,7 +57,7 @@ subroutine psb_cgather_vect(globx, locx, desc_a, info, iroot)
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank
integer(psb_ipk_) :: ierr(5), err_act, jlx, ilx, lda_locx, lda_globx, i integer(psb_ipk_) :: ierr(5), err_act, jlx, ilx, lda_locx, lda_globx, i
integer(psb_lpk_) :: m, n, k, ilocx, jlocx, idx, iglobx, jglobx integer(psb_lpk_) :: m, n, k, ilocx, jlocx, idx, iglobx, jglobx
@ -71,10 +71,10 @@ subroutine psb_cgather_vect(globx, locx, desc_a, info, iroot)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -149,12 +149,12 @@ subroutine psb_cgather_vect(globx, locx, desc_a, info, iroot)
end if end if
end do end do
call psb_sum(ictxt,globx(1:m),root=root) call psb_sum(ctxt,globx(1:m),root=root)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
@ -175,7 +175,7 @@ subroutine psb_cgather_multivect(globx, locx, desc_a, info, iroot)
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank
integer(psb_ipk_) :: ierr(5), err_act, jlx, ilx, lda_locx, lda_globx, i integer(psb_ipk_) :: ierr(5), err_act, jlx, ilx, lda_locx, lda_globx, i
integer(psb_lpk_) :: m, n, k, ilocx, jlocx, idx, iglobx, jglobx integer(psb_lpk_) :: m, n, k, ilocx, jlocx, idx, iglobx, jglobx
@ -189,10 +189,10 @@ subroutine psb_cgather_multivect(globx, locx, desc_a, info, iroot)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -266,12 +266,12 @@ subroutine psb_cgather_multivect(globx, locx, desc_a, info, iroot)
end if end if
end do end do
call psb_sum(ictxt,globx(1:m,1:k),root=root) call psb_sum(ctxt,globx(1:m,1:k),root=root)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return

22
base/comm/psb_cgather_a.f90
Unescape Escape View File

@ -57,7 +57,7 @@ subroutine psb_cgatherm(globx, locx, desc_a, info, iroot)
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank
integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,& integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,&
& maxk, k, jlx, ilx, i, j & maxk, k, jlx, ilx, i, j
@ -71,9 +71,9 @@ subroutine psb_cgatherm(globx, locx, desc_a, info, iroot)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -110,7 +110,7 @@ subroutine psb_cgatherm(globx, locx, desc_a, info, iroot)
maxk = lock maxk = lock
k = maxk k = maxk
call psb_bcast(ictxt,k,root=iiroot) call psb_bcast(ctxt,k,root=iiroot)
! there should be a global check on k here!!! ! there should be a global check on k here!!!
@ -157,12 +157,12 @@ subroutine psb_cgatherm(globx, locx, desc_a, info, iroot)
end do end do
end do end do
call psb_sum(ictxt,globx(1:m,1:k),root=root) call psb_sum(ctxt,globx(1:m,1:k),root=root)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
@ -231,7 +231,7 @@ subroutine psb_cgatherv(globx, locx, desc_a, info, iroot)
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank
integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,& integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,&
& maxk, k, jlx, ilx, i, j & maxk, k, jlx, ilx, i, j
@ -246,10 +246,10 @@ subroutine psb_cgatherv(globx, locx, desc_a, info, iroot)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -323,12 +323,12 @@ subroutine psb_cgatherv(globx, locx, desc_a, info, iroot)
end if end if
end do end do
call psb_sum(ictxt,globx(1:m),root=root) call psb_sum(ctxt,globx(1:m),root=root)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return

16
base/comm/psb_chalo.f90
Unescape Escape View File

@ -65,7 +65,7 @@ subroutine psb_chalo_vect(x,desc_a,info,work,tran,mode,data)
character, intent(in), optional :: tran character, intent(in), optional :: tran
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, iix, jjx, & integer(psb_ipk_) :: np, me, err_act, iix, jjx, &
& nrow, ncol, lldx, imode, liwork,data_ & nrow, ncol, lldx, imode, liwork,data_
integer(psb_lpk_) :: m, n, ix, ijx integer(psb_lpk_) :: m, n, ix, ijx
@ -81,10 +81,10 @@ subroutine psb_chalo_vect(x,desc_a,info,work,tran,mode,data)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -180,7 +180,7 @@ subroutine psb_chalo_vect(x,desc_a,info,work,tran,mode,data)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psb_chalo_vect end subroutine psb_chalo_vect
@ -220,7 +220,7 @@ subroutine psb_chalo_multivect(x,desc_a,info,work,tran,mode,data)
character, intent(in), optional :: tran character, intent(in), optional :: tran
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, iix, jjx, & integer(psb_ipk_) :: np, me, err_act, iix, jjx, &
& nrow, ncol, lldx, imode, liwork,data_ & nrow, ncol, lldx, imode, liwork,data_
integer(psb_lpk_) :: m, n, ix, ijx integer(psb_lpk_) :: m, n, ix, ijx
@ -236,10 +236,10 @@ subroutine psb_chalo_multivect(x,desc_a,info,work,tran,mode,data)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -336,7 +336,7 @@ subroutine psb_chalo_multivect(x,desc_a,info,work,tran,mode,data)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psb_chalo_multivect end subroutine psb_chalo_multivect

16
base/comm/psb_chalo_a.f90
Unescape Escape View File

@ -65,7 +65,7 @@ subroutine psb_chalom(x,desc_a,info,jx,ik,work,tran,mode,data)
character, intent(in), optional :: tran character, intent(in), optional :: tran
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: err_act, iix, jjx, k, maxk, nrow, imode, i,& integer(psb_ipk_) :: err_act, iix, jjx, k, maxk, nrow, imode, i,&
& liwork,data_, ldx & liwork,data_, ldx
@ -82,10 +82,10 @@ subroutine psb_chalom(x,desc_a,info,jx,ik,work,tran,mode,data)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -193,7 +193,7 @@ subroutine psb_chalom(x,desc_a,info,jx,ik,work,tran,mode,data)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psb_chalom end subroutine psb_chalom
@ -267,7 +267,7 @@ subroutine psb_chalov(x,desc_a,info,work,tran,mode,data)
character, intent(in), optional :: tran character, intent(in), optional :: tran
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: err_act, ldx, iix, jjx, nrow, imode, liwork,data_ integer(psb_ipk_) :: err_act, ldx, iix, jjx, nrow, imode, liwork,data_
integer(psb_lpk_) :: m, n, ix, ijx integer(psb_lpk_) :: m, n, ix, ijx
@ -283,10 +283,10 @@ subroutine psb_chalov(x,desc_a,info,work,tran,mode,data)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -375,7 +375,7 @@ subroutine psb_chalov(x,desc_a,info,work,tran,mode,data)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psb_chalov end subroutine psb_chalov

16
base/comm/psb_covrl.f90
Unescape Escape View File

@ -75,7 +75,7 @@ subroutine psb_covrl_vect(x,desc_a,info,work,update,mode)
integer(psb_ipk_), intent(in), optional :: update,mode integer(psb_ipk_), intent(in), optional :: update,mode
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, & integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, &
& nrow, ncol, ldx, liwork, data_, update_, mode_ & nrow, ncol, ldx, liwork, data_, update_, mode_
integer(psb_lpk_) :: m, n, ix, ijx integer(psb_lpk_) :: m, n, ix, ijx
@ -91,10 +91,10 @@ subroutine psb_covrl_vect(x,desc_a,info,work,update,mode)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -176,7 +176,7 @@ subroutine psb_covrl_vect(x,desc_a,info,work,update,mode)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psb_covrl_vect end subroutine psb_covrl_vect
@ -225,7 +225,7 @@ subroutine psb_covrl_multivect(x,desc_a,info,work,update,mode)
integer(psb_ipk_), intent(in), optional :: update,mode integer(psb_ipk_), intent(in), optional :: update,mode
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, & integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, &
& nrow, ncol, ldx, liwork, data_, update_, mode_ & nrow, ncol, ldx, liwork, data_, update_, mode_
integer(psb_lpk_) :: m, n, ix, ijx integer(psb_lpk_) :: m, n, ix, ijx
@ -241,10 +241,10 @@ subroutine psb_covrl_multivect(x,desc_a,info,work,update,mode)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -328,7 +328,7 @@ subroutine psb_covrl_multivect(x,desc_a,info,work,update,mode)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psb_covrl_multivect end subroutine psb_covrl_multivect

16
base/comm/psb_covrl_a.f90
Unescape Escape View File

@ -76,7 +76,7 @@ subroutine psb_covrlm(x,desc_a,info,jx,ik,work,update,mode)
integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, k, maxk, update_,& integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, k, maxk, update_,&
& mode_, liwork, ldx & mode_, liwork, ldx
@ -93,10 +93,10 @@ subroutine psb_covrlm(x,desc_a,info,jx,ik,work,update,mode)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -188,7 +188,7 @@ subroutine psb_covrlm(x,desc_a,info,jx,ik,work,update,mode)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psb_covrlm end subroutine psb_covrlm
@ -266,7 +266,7 @@ subroutine psb_covrlv(x,desc_a,info,work,update,mode)
integer(psb_ipk_), intent(in), optional :: update,mode integer(psb_ipk_), intent(in), optional :: update,mode
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, iix, jjx, nrow, ncol, & integer(psb_ipk_) :: np, me, err_act, iix, jjx, nrow, ncol, &
& k, update_, mode_, liwork, ldx & k, update_, mode_, liwork, ldx
integer(psb_lpk_) :: m, n, ix, ijx integer(psb_lpk_) :: m, n, ix, ijx
@ -282,10 +282,10 @@ subroutine psb_covrlv(x,desc_a,info,work,update,mode)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -370,7 +370,7 @@ subroutine psb_covrlv(x,desc_a,info,work,update,mode)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psb_covrlv end subroutine psb_covrlv

8
base/comm/psb_cscatter.F90
Unescape Escape View File

@ -54,7 +54,7 @@ subroutine psb_cscatter_vect(globx, locx, desc_a, info, root, mold)
class(psb_c_base_vect_type), intent(in), optional :: mold class(psb_c_base_vect_type), intent(in), optional :: mold
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me, icomm, myrank, rootrank integer(psb_mpk_) :: np, me, icomm, myrank, rootrank
integer(psb_ipk_) :: ierr(5), err_act, m, n, i, j, idx, nrow, iglobx, jglobx,& integer(psb_ipk_) :: ierr(5), err_act, m, n, i, j, idx, nrow, iglobx, jglobx,&
& ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx
@ -68,13 +68,13 @@ subroutine psb_cscatter_vect(globx, locx, desc_a, info, root, mold)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -93,7 +93,7 @@ subroutine psb_cscatter_vect(globx, locx, desc_a, info, root, mold)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return

28
base/comm/psb_cscatter_a.F90
Unescape Escape View File

@ -62,7 +62,7 @@ subroutine psb_cscatterm(globx, locx, desc_a, info, root)
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam, nlr integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam, nlr
integer(psb_ipk_) :: ierr(5), err_act, nrow,& integer(psb_ipk_) :: ierr(5), err_act, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, & & ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, &
@ -80,10 +80,10 @@ subroutine psb_cscatterm(globx, locx, desc_a, info, root)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, iam, np) call psb_info(ctxt, iam, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -108,8 +108,8 @@ subroutine psb_cscatterm(globx, locx, desc_a, info, root)
m = desc_a%get_global_rows() m = desc_a%get_global_rows()
n = desc_a%get_global_cols() n = desc_a%get_global_cols()
icomm = psb_get_mpi_comm(ictxt) icomm = psb_get_mpi_comm(ctxt)
myrank = psb_get_mpi_rank(ictxt,me) myrank = psb_get_mpi_rank(ctxt,me)
if (iroot==-1) then if (iroot==-1) then
lda_globx = size(globx, 1) lda_globx = size(globx, 1)
@ -160,7 +160,7 @@ subroutine psb_cscatterm(globx, locx, desc_a, info, root)
end do end do
else else
rootrank = psb_get_mpi_rank(ictxt,iroot) rootrank = psb_get_mpi_rank(ctxt,iroot)
! !
! This is potentially unsafe when IPK=8 ! This is potentially unsafe when IPK=8
! But then, IPK=8 is highly experimental anyway. ! But then, IPK=8 is highly experimental anyway.
@ -236,7 +236,7 @@ subroutine psb_cscatterm(globx, locx, desc_a, info, root)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
@ -307,7 +307,7 @@ subroutine psb_cscatterv(globx, locx, desc_a, info, root)
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr
integer(psb_ipk_) :: ierr(5), err_act, nrow,& integer(psb_ipk_) :: ierr(5), err_act, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx
@ -324,13 +324,13 @@ subroutine psb_cscatterv(globx, locx, desc_a, info, root)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, iam, np) call psb_info(ctxt, iam, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -349,8 +349,8 @@ subroutine psb_cscatterv(globx, locx, desc_a, info, root)
iroot = psb_root_ iroot = psb_root_
end if end if
icomm = psb_get_mpi_comm(ictxt) icomm = psb_get_mpi_comm(ctxt)
myrank = psb_get_mpi_rank(ictxt,iam) myrank = psb_get_mpi_rank(ctxt,iam)
iglobx = 1 iglobx = 1
jglobx = 1 jglobx = 1
@ -396,7 +396,7 @@ subroutine psb_cscatterv(globx, locx, desc_a, info, root)
locx(i)=globx(ltg(i)) locx(i)=globx(ltg(i))
end do end do
else else
rootrank = psb_get_mpi_rank(ictxt,iroot) rootrank = psb_get_mpi_rank(ctxt,iroot)
! !
! This is potentially unsafe when IPK=8 ! This is potentially unsafe when IPK=8
! But then, IPK=8 is highly experimental anyway. ! But then, IPK=8 is highly experimental anyway.
@ -474,7 +474,7 @@ subroutine psb_cscatterv(globx, locx, desc_a, info, root)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return

30
base/comm/psb_cspgather.F90
Unescape Escape View File

@ -67,7 +67,7 @@ subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
integer(psb_ipk_) :: err_act, dupl_ integer(psb_ipk_) :: err_act, dupl_
integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k
logical :: keepnum_, keeploc_ logical :: keepnum_, keeploc_
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me integer(psb_mpk_) :: np, me
integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_) :: icomm, minfo, ndx, root_
integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_mpk_), allocatable :: nzbr(:), idisp(:)
@ -83,9 +83,9 @@ subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (present(keepnum)) then if (present(keepnum)) then
keepnum_ = keepnum keepnum_ = keepnum
@ -129,7 +129,7 @@ subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
call psb_loc_to_glob(loc_coo%ja(1:nzl),locja(1:nzl),desc_a,info,iact='I') call psb_loc_to_glob(loc_coo%ja(1:nzl),locja(1:nzl),desc_a,info,iact='I')
nzbr(:) = 0 nzbr(:) = 0
nzbr(me+1) = nzl nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np)) call psb_sum(ctxt,nzbr(1:np))
nzg = sum(nzbr) nzg = sum(nzbr)
if (nzg <0) then if (nzg <0) then
info = psb_err_mpi_int_ovflw_ info = psb_err_mpi_int_ovflw_
@ -217,7 +217,7 @@ subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
9999 continue 9999 continue
call psb_errpush(info,name) call psb_errpush(info,name)
call psb_error_handler(ictxt,err_act) call psb_error_handler(ctxt,err_act)
return return
@ -250,7 +250,7 @@ subroutine psb_lcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
integer(psb_ipk_) :: err_act, dupl_ integer(psb_ipk_) :: err_act, dupl_
integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl
logical :: keepnum_, keeploc_ logical :: keepnum_, keeploc_
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_) :: icomm, minfo, ndx, root_
integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_mpk_), allocatable :: nzbr(:), idisp(:)
@ -266,9 +266,9 @@ subroutine psb_lcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (present(keepnum)) then if (present(keepnum)) then
keepnum_ = keepnum keepnum_ = keepnum
@ -310,7 +310,7 @@ subroutine psb_lcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
call psb_loc_to_glob(loc_coo%ja(1:nzl),desc_a,info,iact='I') call psb_loc_to_glob(loc_coo%ja(1:nzl),desc_a,info,iact='I')
nzbr(:) = 0 nzbr(:) = 0
nzbr(me+1) = nzl nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np)) call psb_sum(ctxt,nzbr(1:np))
lnzbr = nzbr lnzbr = nzbr
nzg = sum(nzbr) nzg = sum(nzbr)
if ((nzg < 0).or.(nzg /= sum(lnzbr))) then if ((nzg < 0).or.(nzg /= sum(lnzbr))) then
@ -390,7 +390,7 @@ subroutine psb_lcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
9999 continue 9999 continue
call psb_errpush(info,name) call psb_errpush(info,name)
call psb_error_handler(ictxt,err_act) call psb_error_handler(ctxt,err_act)
return return
@ -422,7 +422,7 @@ subroutine psb_lclcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
integer(psb_ipk_) :: err_act, dupl_ integer(psb_ipk_) :: err_act, dupl_
integer(psb_lpk_) :: ip,naggrm1,naggrp1, i, j, k, nzl integer(psb_lpk_) :: ip,naggrm1,naggrp1, i, j, k, nzl
logical :: keepnum_, keeploc_ logical :: keepnum_, keeploc_
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_) :: icomm, minfo, ndx, root_
integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_mpk_), allocatable :: nzbr(:), idisp(:)
@ -438,9 +438,9 @@ subroutine psb_lclcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (present(keepnum)) then if (present(keepnum)) then
keepnum_ = keepnum keepnum_ = keepnum
@ -482,7 +482,7 @@ subroutine psb_lclcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
call psb_loc_to_glob(loc_coo%ja(1:nzl),desc_a,info,iact='I') call psb_loc_to_glob(loc_coo%ja(1:nzl),desc_a,info,iact='I')
nzbr(:) = 0 nzbr(:) = 0
nzbr(me+1) = nzl nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np)) call psb_sum(ctxt,nzbr(1:np))
lnzbr = nzbr lnzbr = nzbr
nzg = sum(nzbr) nzg = sum(nzbr)
if ((nzg < 0).or.(nzg /= sum(lnzbr))) then if ((nzg < 0).or.(nzg /= sum(lnzbr))) then
@ -557,7 +557,7 @@ subroutine psb_lclcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
9999 continue 9999 continue
call psb_errpush(info,name) call psb_errpush(info,name)
call psb_error_handler(ictxt,err_act) call psb_error_handler(ctxt,err_act)
return return

20
base/comm/psb_dgather.f90
Unescape Escape View File

@ -57,7 +57,7 @@ subroutine psb_dgather_vect(globx, locx, desc_a, info, iroot)
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank
integer(psb_ipk_) :: ierr(5), err_act, jlx, ilx, lda_locx, lda_globx, i integer(psb_ipk_) :: ierr(5), err_act, jlx, ilx, lda_locx, lda_globx, i
integer(psb_lpk_) :: m, n, k, ilocx, jlocx, idx, iglobx, jglobx integer(psb_lpk_) :: m, n, k, ilocx, jlocx, idx, iglobx, jglobx
@ -71,10 +71,10 @@ subroutine psb_dgather_vect(globx, locx, desc_a, info, iroot)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -149,12 +149,12 @@ subroutine psb_dgather_vect(globx, locx, desc_a, info, iroot)
end if end if
end do end do
call psb_sum(ictxt,globx(1:m),root=root) call psb_sum(ctxt,globx(1:m),root=root)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
@ -175,7 +175,7 @@ subroutine psb_dgather_multivect(globx, locx, desc_a, info, iroot)
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank
integer(psb_ipk_) :: ierr(5), err_act, jlx, ilx, lda_locx, lda_globx, i integer(psb_ipk_) :: ierr(5), err_act, jlx, ilx, lda_locx, lda_globx, i
integer(psb_lpk_) :: m, n, k, ilocx, jlocx, idx, iglobx, jglobx integer(psb_lpk_) :: m, n, k, ilocx, jlocx, idx, iglobx, jglobx
@ -189,10 +189,10 @@ subroutine psb_dgather_multivect(globx, locx, desc_a, info, iroot)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -266,12 +266,12 @@ subroutine psb_dgather_multivect(globx, locx, desc_a, info, iroot)
end if end if
end do end do
call psb_sum(ictxt,globx(1:m,1:k),root=root) call psb_sum(ctxt,globx(1:m,1:k),root=root)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return

22
base/comm/psb_dgather_a.f90
Unescape Escape View File

@ -57,7 +57,7 @@ subroutine psb_dgatherm(globx, locx, desc_a, info, iroot)
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank
integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,& integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,&
& maxk, k, jlx, ilx, i, j & maxk, k, jlx, ilx, i, j
@ -71,9 +71,9 @@ subroutine psb_dgatherm(globx, locx, desc_a, info, iroot)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -110,7 +110,7 @@ subroutine psb_dgatherm(globx, locx, desc_a, info, iroot)
maxk = lock maxk = lock
k = maxk k = maxk
call psb_bcast(ictxt,k,root=iiroot) call psb_bcast(ctxt,k,root=iiroot)
! there should be a global check on k here!!! ! there should be a global check on k here!!!
@ -157,12 +157,12 @@ subroutine psb_dgatherm(globx, locx, desc_a, info, iroot)
end do end do
end do end do
call psb_sum(ictxt,globx(1:m,1:k),root=root) call psb_sum(ctxt,globx(1:m,1:k),root=root)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
@ -231,7 +231,7 @@ subroutine psb_dgatherv(globx, locx, desc_a, info, iroot)
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank
integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,& integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,&
& maxk, k, jlx, ilx, i, j & maxk, k, jlx, ilx, i, j
@ -246,10 +246,10 @@ subroutine psb_dgatherv(globx, locx, desc_a, info, iroot)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -323,12 +323,12 @@ subroutine psb_dgatherv(globx, locx, desc_a, info, iroot)
end if end if
end do end do
call psb_sum(ictxt,globx(1:m),root=root) call psb_sum(ctxt,globx(1:m),root=root)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return

16
base/comm/psb_dhalo.f90
Unescape Escape View File

@ -65,7 +65,7 @@ subroutine psb_dhalo_vect(x,desc_a,info,work,tran,mode,data)
character, intent(in), optional :: tran character, intent(in), optional :: tran
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, iix, jjx, & integer(psb_ipk_) :: np, me, err_act, iix, jjx, &
& nrow, ncol, lldx, imode, liwork,data_ & nrow, ncol, lldx, imode, liwork,data_
integer(psb_lpk_) :: m, n, ix, ijx integer(psb_lpk_) :: m, n, ix, ijx
@ -81,10 +81,10 @@ subroutine psb_dhalo_vect(x,desc_a,info,work,tran,mode,data)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -180,7 +180,7 @@ subroutine psb_dhalo_vect(x,desc_a,info,work,tran,mode,data)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psb_dhalo_vect end subroutine psb_dhalo_vect
@ -220,7 +220,7 @@ subroutine psb_dhalo_multivect(x,desc_a,info,work,tran,mode,data)
character, intent(in), optional :: tran character, intent(in), optional :: tran
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, iix, jjx, & integer(psb_ipk_) :: np, me, err_act, iix, jjx, &
& nrow, ncol, lldx, imode, liwork,data_ & nrow, ncol, lldx, imode, liwork,data_
integer(psb_lpk_) :: m, n, ix, ijx integer(psb_lpk_) :: m, n, ix, ijx
@ -236,10 +236,10 @@ subroutine psb_dhalo_multivect(x,desc_a,info,work,tran,mode,data)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -336,7 +336,7 @@ subroutine psb_dhalo_multivect(x,desc_a,info,work,tran,mode,data)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psb_dhalo_multivect end subroutine psb_dhalo_multivect

16
base/comm/psb_dhalo_a.f90
Unescape Escape View File

@ -65,7 +65,7 @@ subroutine psb_dhalom(x,desc_a,info,jx,ik,work,tran,mode,data)
character, intent(in), optional :: tran character, intent(in), optional :: tran
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: err_act, iix, jjx, k, maxk, nrow, imode, i,& integer(psb_ipk_) :: err_act, iix, jjx, k, maxk, nrow, imode, i,&
& liwork,data_, ldx & liwork,data_, ldx
@ -82,10 +82,10 @@ subroutine psb_dhalom(x,desc_a,info,jx,ik,work,tran,mode,data)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -193,7 +193,7 @@ subroutine psb_dhalom(x,desc_a,info,jx,ik,work,tran,mode,data)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psb_dhalom end subroutine psb_dhalom
@ -267,7 +267,7 @@ subroutine psb_dhalov(x,desc_a,info,work,tran,mode,data)
character, intent(in), optional :: tran character, intent(in), optional :: tran
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: err_act, ldx, iix, jjx, nrow, imode, liwork,data_ integer(psb_ipk_) :: err_act, ldx, iix, jjx, nrow, imode, liwork,data_
integer(psb_lpk_) :: m, n, ix, ijx integer(psb_lpk_) :: m, n, ix, ijx
@ -283,10 +283,10 @@ subroutine psb_dhalov(x,desc_a,info,work,tran,mode,data)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -375,7 +375,7 @@ subroutine psb_dhalov(x,desc_a,info,work,tran,mode,data)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psb_dhalov end subroutine psb_dhalov

16
base/comm/psb_dovrl.f90
Unescape Escape View File

@ -75,7 +75,7 @@ subroutine psb_dovrl_vect(x,desc_a,info,work,update,mode)
integer(psb_ipk_), intent(in), optional :: update,mode integer(psb_ipk_), intent(in), optional :: update,mode
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, & integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, &
& nrow, ncol, ldx, liwork, data_, update_, mode_ & nrow, ncol, ldx, liwork, data_, update_, mode_
integer(psb_lpk_) :: m, n, ix, ijx integer(psb_lpk_) :: m, n, ix, ijx
@ -91,10 +91,10 @@ subroutine psb_dovrl_vect(x,desc_a,info,work,update,mode)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -176,7 +176,7 @@ subroutine psb_dovrl_vect(x,desc_a,info,work,update,mode)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psb_dovrl_vect end subroutine psb_dovrl_vect
@ -225,7 +225,7 @@ subroutine psb_dovrl_multivect(x,desc_a,info,work,update,mode)
integer(psb_ipk_), intent(in), optional :: update,mode integer(psb_ipk_), intent(in), optional :: update,mode
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, & integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, &
& nrow, ncol, ldx, liwork, data_, update_, mode_ & nrow, ncol, ldx, liwork, data_, update_, mode_
integer(psb_lpk_) :: m, n, ix, ijx integer(psb_lpk_) :: m, n, ix, ijx
@ -241,10 +241,10 @@ subroutine psb_dovrl_multivect(x,desc_a,info,work,update,mode)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -328,7 +328,7 @@ subroutine psb_dovrl_multivect(x,desc_a,info,work,update,mode)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psb_dovrl_multivect end subroutine psb_dovrl_multivect

16
base/comm/psb_dovrl_a.f90
Unescape Escape View File

@ -76,7 +76,7 @@ subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,update,mode)
integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, k, maxk, update_,& integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, k, maxk, update_,&
& mode_, liwork, ldx & mode_, liwork, ldx
@ -93,10 +93,10 @@ subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,update,mode)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -188,7 +188,7 @@ subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,update,mode)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psb_dovrlm end subroutine psb_dovrlm
@ -266,7 +266,7 @@ subroutine psb_dovrlv(x,desc_a,info,work,update,mode)
integer(psb_ipk_), intent(in), optional :: update,mode integer(psb_ipk_), intent(in), optional :: update,mode
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, iix, jjx, nrow, ncol, & integer(psb_ipk_) :: np, me, err_act, iix, jjx, nrow, ncol, &
& k, update_, mode_, liwork, ldx & k, update_, mode_, liwork, ldx
integer(psb_lpk_) :: m, n, ix, ijx integer(psb_lpk_) :: m, n, ix, ijx
@ -282,10 +282,10 @@ subroutine psb_dovrlv(x,desc_a,info,work,update,mode)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -370,7 +370,7 @@ subroutine psb_dovrlv(x,desc_a,info,work,update,mode)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psb_dovrlv end subroutine psb_dovrlv

8
base/comm/psb_dscatter.F90
Unescape Escape View File

@ -54,7 +54,7 @@ subroutine psb_dscatter_vect(globx, locx, desc_a, info, root, mold)
class(psb_d_base_vect_type), intent(in), optional :: mold class(psb_d_base_vect_type), intent(in), optional :: mold
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me, icomm, myrank, rootrank integer(psb_mpk_) :: np, me, icomm, myrank, rootrank
integer(psb_ipk_) :: ierr(5), err_act, m, n, i, j, idx, nrow, iglobx, jglobx,& integer(psb_ipk_) :: ierr(5), err_act, m, n, i, j, idx, nrow, iglobx, jglobx,&
& ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx
@ -68,13 +68,13 @@ subroutine psb_dscatter_vect(globx, locx, desc_a, info, root, mold)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -93,7 +93,7 @@ subroutine psb_dscatter_vect(globx, locx, desc_a, info, root, mold)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return

28
base/comm/psb_dscatter_a.F90
Unescape Escape View File

@ -62,7 +62,7 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, root)
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam, nlr integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam, nlr
integer(psb_ipk_) :: ierr(5), err_act, nrow,& integer(psb_ipk_) :: ierr(5), err_act, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, & & ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, &
@ -80,10 +80,10 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, root)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, iam, np) call psb_info(ctxt, iam, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -108,8 +108,8 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, root)
m = desc_a%get_global_rows() m = desc_a%get_global_rows()
n = desc_a%get_global_cols() n = desc_a%get_global_cols()
icomm = psb_get_mpi_comm(ictxt) icomm = psb_get_mpi_comm(ctxt)
myrank = psb_get_mpi_rank(ictxt,me) myrank = psb_get_mpi_rank(ctxt,me)
if (iroot==-1) then if (iroot==-1) then
lda_globx = size(globx, 1) lda_globx = size(globx, 1)
@ -160,7 +160,7 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, root)
end do end do
else else
rootrank = psb_get_mpi_rank(ictxt,iroot) rootrank = psb_get_mpi_rank(ctxt,iroot)
! !
! This is potentially unsafe when IPK=8 ! This is potentially unsafe when IPK=8
! But then, IPK=8 is highly experimental anyway. ! But then, IPK=8 is highly experimental anyway.
@ -236,7 +236,7 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, root)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
@ -307,7 +307,7 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, root)
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr
integer(psb_ipk_) :: ierr(5), err_act, nrow,& integer(psb_ipk_) :: ierr(5), err_act, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx
@ -324,13 +324,13 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, root)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, iam, np) call psb_info(ctxt, iam, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -349,8 +349,8 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, root)
iroot = psb_root_ iroot = psb_root_
end if end if
icomm = psb_get_mpi_comm(ictxt) icomm = psb_get_mpi_comm(ctxt)
myrank = psb_get_mpi_rank(ictxt,iam) myrank = psb_get_mpi_rank(ctxt,iam)
iglobx = 1 iglobx = 1
jglobx = 1 jglobx = 1
@ -396,7 +396,7 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, root)
locx(i)=globx(ltg(i)) locx(i)=globx(ltg(i))
end do end do
else else
rootrank = psb_get_mpi_rank(ictxt,iroot) rootrank = psb_get_mpi_rank(ctxt,iroot)
! !
! This is potentially unsafe when IPK=8 ! This is potentially unsafe when IPK=8
! But then, IPK=8 is highly experimental anyway. ! But then, IPK=8 is highly experimental anyway.
@ -474,7 +474,7 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, root)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return

30
base/comm/psb_dspgather.F90
Unescape Escape View File

@ -67,7 +67,7 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
integer(psb_ipk_) :: err_act, dupl_ integer(psb_ipk_) :: err_act, dupl_
integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k
logical :: keepnum_, keeploc_ logical :: keepnum_, keeploc_
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me integer(psb_mpk_) :: np, me
integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_) :: icomm, minfo, ndx, root_
integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_mpk_), allocatable :: nzbr(:), idisp(:)
@ -83,9 +83,9 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (present(keepnum)) then if (present(keepnum)) then
keepnum_ = keepnum keepnum_ = keepnum
@ -129,7 +129,7 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
call psb_loc_to_glob(loc_coo%ja(1:nzl),locja(1:nzl),desc_a,info,iact='I') call psb_loc_to_glob(loc_coo%ja(1:nzl),locja(1:nzl),desc_a,info,iact='I')
nzbr(:) = 0 nzbr(:) = 0
nzbr(me+1) = nzl nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np)) call psb_sum(ctxt,nzbr(1:np))
nzg = sum(nzbr) nzg = sum(nzbr)
if (nzg <0) then if (nzg <0) then
info = psb_err_mpi_int_ovflw_ info = psb_err_mpi_int_ovflw_
@ -217,7 +217,7 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
9999 continue 9999 continue
call psb_errpush(info,name) call psb_errpush(info,name)
call psb_error_handler(ictxt,err_act) call psb_error_handler(ctxt,err_act)
return return
@ -250,7 +250,7 @@ subroutine psb_ldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
integer(psb_ipk_) :: err_act, dupl_ integer(psb_ipk_) :: err_act, dupl_
integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl
logical :: keepnum_, keeploc_ logical :: keepnum_, keeploc_
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_) :: icomm, minfo, ndx, root_
integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_mpk_), allocatable :: nzbr(:), idisp(:)
@ -266,9 +266,9 @@ subroutine psb_ldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (present(keepnum)) then if (present(keepnum)) then
keepnum_ = keepnum keepnum_ = keepnum
@ -310,7 +310,7 @@ subroutine psb_ldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
call psb_loc_to_glob(loc_coo%ja(1:nzl),desc_a,info,iact='I') call psb_loc_to_glob(loc_coo%ja(1:nzl),desc_a,info,iact='I')
nzbr(:) = 0 nzbr(:) = 0
nzbr(me+1) = nzl nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np)) call psb_sum(ctxt,nzbr(1:np))
lnzbr = nzbr lnzbr = nzbr
nzg = sum(nzbr) nzg = sum(nzbr)
if ((nzg < 0).or.(nzg /= sum(lnzbr))) then if ((nzg < 0).or.(nzg /= sum(lnzbr))) then
@ -390,7 +390,7 @@ subroutine psb_ldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
9999 continue 9999 continue
call psb_errpush(info,name) call psb_errpush(info,name)
call psb_error_handler(ictxt,err_act) call psb_error_handler(ctxt,err_act)
return return
@ -422,7 +422,7 @@ subroutine psb_ldldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
integer(psb_ipk_) :: err_act, dupl_ integer(psb_ipk_) :: err_act, dupl_
integer(psb_lpk_) :: ip,naggrm1,naggrp1, i, j, k, nzl integer(psb_lpk_) :: ip,naggrm1,naggrp1, i, j, k, nzl
logical :: keepnum_, keeploc_ logical :: keepnum_, keeploc_
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_) :: icomm, minfo, ndx, root_
integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_mpk_), allocatable :: nzbr(:), idisp(:)
@ -438,9 +438,9 @@ subroutine psb_ldldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (present(keepnum)) then if (present(keepnum)) then
keepnum_ = keepnum keepnum_ = keepnum
@ -482,7 +482,7 @@ subroutine psb_ldldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
call psb_loc_to_glob(loc_coo%ja(1:nzl),desc_a,info,iact='I') call psb_loc_to_glob(loc_coo%ja(1:nzl),desc_a,info,iact='I')
nzbr(:) = 0 nzbr(:) = 0
nzbr(me+1) = nzl nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np)) call psb_sum(ctxt,nzbr(1:np))
lnzbr = nzbr lnzbr = nzbr
nzg = sum(nzbr) nzg = sum(nzbr)
if ((nzg < 0).or.(nzg /= sum(lnzbr))) then if ((nzg < 0).or.(nzg /= sum(lnzbr))) then
@ -557,7 +557,7 @@ subroutine psb_ldldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
9999 continue 9999 continue
call psb_errpush(info,name) call psb_errpush(info,name)
call psb_error_handler(ictxt,err_act) call psb_error_handler(ctxt,err_act)
return return

22
base/comm/psb_egather_a.f90
Unescape Escape View File

@ -57,7 +57,7 @@ subroutine psb_egatherm(globx, locx, desc_a, info, iroot)
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank
integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,& integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,&
& maxk, k, jlx, ilx, i, j & maxk, k, jlx, ilx, i, j
@ -71,9 +71,9 @@ subroutine psb_egatherm(globx, locx, desc_a, info, iroot)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -110,7 +110,7 @@ subroutine psb_egatherm(globx, locx, desc_a, info, iroot)
maxk = lock maxk = lock
k = maxk k = maxk
call psb_bcast(ictxt,k,root=iiroot) call psb_bcast(ctxt,k,root=iiroot)
! there should be a global check on k here!!! ! there should be a global check on k here!!!
@ -157,12 +157,12 @@ subroutine psb_egatherm(globx, locx, desc_a, info, iroot)
end do end do
end do end do
call psb_sum(ictxt,globx(1:m,1:k),root=root) call psb_sum(ctxt,globx(1:m,1:k),root=root)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
@ -231,7 +231,7 @@ subroutine psb_egatherv(globx, locx, desc_a, info, iroot)
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank
integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,& integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,&
& maxk, k, jlx, ilx, i, j & maxk, k, jlx, ilx, i, j
@ -246,10 +246,10 @@ subroutine psb_egatherv(globx, locx, desc_a, info, iroot)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -323,12 +323,12 @@ subroutine psb_egatherv(globx, locx, desc_a, info, iroot)
end if end if
end do end do
call psb_sum(ictxt,globx(1:m),root=root) call psb_sum(ctxt,globx(1:m),root=root)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return

16
base/comm/psb_ehalo_a.f90
Unescape Escape View File

@ -65,7 +65,7 @@ subroutine psb_ehalom(x,desc_a,info,jx,ik,work,tran,mode,data)
character, intent(in), optional :: tran character, intent(in), optional :: tran
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: err_act, iix, jjx, k, maxk, nrow, imode, i,& integer(psb_ipk_) :: err_act, iix, jjx, k, maxk, nrow, imode, i,&
& liwork,data_, ldx & liwork,data_, ldx
@ -82,10 +82,10 @@ subroutine psb_ehalom(x,desc_a,info,jx,ik,work,tran,mode,data)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -193,7 +193,7 @@ subroutine psb_ehalom(x,desc_a,info,jx,ik,work,tran,mode,data)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psb_ehalom end subroutine psb_ehalom
@ -267,7 +267,7 @@ subroutine psb_ehalov(x,desc_a,info,work,tran,mode,data)
character, intent(in), optional :: tran character, intent(in), optional :: tran
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: err_act, ldx, iix, jjx, nrow, imode, liwork,data_ integer(psb_ipk_) :: err_act, ldx, iix, jjx, nrow, imode, liwork,data_
integer(psb_lpk_) :: m, n, ix, ijx integer(psb_lpk_) :: m, n, ix, ijx
@ -283,10 +283,10 @@ subroutine psb_ehalov(x,desc_a,info,work,tran,mode,data)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -375,7 +375,7 @@ subroutine psb_ehalov(x,desc_a,info,work,tran,mode,data)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psb_ehalov end subroutine psb_ehalov

16
base/comm/psb_eovrl_a.f90
Unescape Escape View File

@ -76,7 +76,7 @@ subroutine psb_eovrlm(x,desc_a,info,jx,ik,work,update,mode)
integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, k, maxk, update_,& integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, k, maxk, update_,&
& mode_, liwork, ldx & mode_, liwork, ldx
@ -93,10 +93,10 @@ subroutine psb_eovrlm(x,desc_a,info,jx,ik,work,update,mode)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -188,7 +188,7 @@ subroutine psb_eovrlm(x,desc_a,info,jx,ik,work,update,mode)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psb_eovrlm end subroutine psb_eovrlm
@ -266,7 +266,7 @@ subroutine psb_eovrlv(x,desc_a,info,work,update,mode)
integer(psb_ipk_), intent(in), optional :: update,mode integer(psb_ipk_), intent(in), optional :: update,mode
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, iix, jjx, nrow, ncol, & integer(psb_ipk_) :: np, me, err_act, iix, jjx, nrow, ncol, &
& k, update_, mode_, liwork, ldx & k, update_, mode_, liwork, ldx
integer(psb_lpk_) :: m, n, ix, ijx integer(psb_lpk_) :: m, n, ix, ijx
@ -282,10 +282,10 @@ subroutine psb_eovrlv(x,desc_a,info,work,update,mode)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -370,7 +370,7 @@ subroutine psb_eovrlv(x,desc_a,info,work,update,mode)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psb_eovrlv end subroutine psb_eovrlv

28
base/comm/psb_escatter_a.F90
Unescape Escape View File

@ -62,7 +62,7 @@ subroutine psb_escatterm(globx, locx, desc_a, info, root)
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam, nlr integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam, nlr
integer(psb_ipk_) :: ierr(5), err_act, nrow,& integer(psb_ipk_) :: ierr(5), err_act, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, & & ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, &
@ -80,10 +80,10 @@ subroutine psb_escatterm(globx, locx, desc_a, info, root)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, iam, np) call psb_info(ctxt, iam, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -108,8 +108,8 @@ subroutine psb_escatterm(globx, locx, desc_a, info, root)
m = desc_a%get_global_rows() m = desc_a%get_global_rows()
n = desc_a%get_global_cols() n = desc_a%get_global_cols()
icomm = psb_get_mpi_comm(ictxt) icomm = psb_get_mpi_comm(ctxt)
myrank = psb_get_mpi_rank(ictxt,me) myrank = psb_get_mpi_rank(ctxt,me)
if (iroot==-1) then if (iroot==-1) then
lda_globx = size(globx, 1) lda_globx = size(globx, 1)
@ -160,7 +160,7 @@ subroutine psb_escatterm(globx, locx, desc_a, info, root)
end do end do
else else
rootrank = psb_get_mpi_rank(ictxt,iroot) rootrank = psb_get_mpi_rank(ctxt,iroot)
! !
! This is potentially unsafe when IPK=8 ! This is potentially unsafe when IPK=8
! But then, IPK=8 is highly experimental anyway. ! But then, IPK=8 is highly experimental anyway.
@ -236,7 +236,7 @@ subroutine psb_escatterm(globx, locx, desc_a, info, root)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
@ -307,7 +307,7 @@ subroutine psb_escatterv(globx, locx, desc_a, info, root)
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr
integer(psb_ipk_) :: ierr(5), err_act, nrow,& integer(psb_ipk_) :: ierr(5), err_act, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx
@ -324,13 +324,13 @@ subroutine psb_escatterv(globx, locx, desc_a, info, root)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, iam, np) call psb_info(ctxt, iam, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -349,8 +349,8 @@ subroutine psb_escatterv(globx, locx, desc_a, info, root)
iroot = psb_root_ iroot = psb_root_
end if end if
icomm = psb_get_mpi_comm(ictxt) icomm = psb_get_mpi_comm(ctxt)
myrank = psb_get_mpi_rank(ictxt,iam) myrank = psb_get_mpi_rank(ctxt,iam)
iglobx = 1 iglobx = 1
jglobx = 1 jglobx = 1
@ -396,7 +396,7 @@ subroutine psb_escatterv(globx, locx, desc_a, info, root)
locx(i)=globx(ltg(i)) locx(i)=globx(ltg(i))
end do end do
else else
rootrank = psb_get_mpi_rank(ictxt,iroot) rootrank = psb_get_mpi_rank(ctxt,iroot)
! !
! This is potentially unsafe when IPK=8 ! This is potentially unsafe when IPK=8
! But then, IPK=8 is highly experimental anyway. ! But then, IPK=8 is highly experimental anyway.
@ -474,7 +474,7 @@ subroutine psb_escatterv(globx, locx, desc_a, info, root)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return

22
base/comm/psb_i2gather_a.f90
Unescape Escape View File

@ -57,7 +57,7 @@ subroutine psb_i2gatherm(globx, locx, desc_a, info, iroot)
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank
integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,& integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,&
& maxk, k, jlx, ilx, i, j & maxk, k, jlx, ilx, i, j
@ -71,9 +71,9 @@ subroutine psb_i2gatherm(globx, locx, desc_a, info, iroot)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -110,7 +110,7 @@ subroutine psb_i2gatherm(globx, locx, desc_a, info, iroot)
maxk = lock maxk = lock
k = maxk k = maxk
call psb_bcast(ictxt,k,root=iiroot) call psb_bcast(ctxt,k,root=iiroot)
! there should be a global check on k here!!! ! there should be a global check on k here!!!
@ -157,12 +157,12 @@ subroutine psb_i2gatherm(globx, locx, desc_a, info, iroot)
end do end do
end do end do
call psb_sum(ictxt,globx(1:m,1:k),root=root) call psb_sum(ctxt,globx(1:m,1:k),root=root)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
@ -231,7 +231,7 @@ subroutine psb_i2gatherv(globx, locx, desc_a, info, iroot)
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank
integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,& integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,&
& maxk, k, jlx, ilx, i, j & maxk, k, jlx, ilx, i, j
@ -246,10 +246,10 @@ subroutine psb_i2gatherv(globx, locx, desc_a, info, iroot)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -323,12 +323,12 @@ subroutine psb_i2gatherv(globx, locx, desc_a, info, iroot)
end if end if
end do end do
call psb_sum(ictxt,globx(1:m),root=root) call psb_sum(ctxt,globx(1:m),root=root)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return

16
base/comm/psb_i2halo_a.f90
Unescape Escape View File

@ -65,7 +65,7 @@ subroutine psb_i2halom(x,desc_a,info,jx,ik,work,tran,mode,data)
character, intent(in), optional :: tran character, intent(in), optional :: tran
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: err_act, iix, jjx, k, maxk, nrow, imode, i,& integer(psb_ipk_) :: err_act, iix, jjx, k, maxk, nrow, imode, i,&
& liwork,data_, ldx & liwork,data_, ldx
@ -82,10 +82,10 @@ subroutine psb_i2halom(x,desc_a,info,jx,ik,work,tran,mode,data)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -193,7 +193,7 @@ subroutine psb_i2halom(x,desc_a,info,jx,ik,work,tran,mode,data)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psb_i2halom end subroutine psb_i2halom
@ -267,7 +267,7 @@ subroutine psb_i2halov(x,desc_a,info,work,tran,mode,data)
character, intent(in), optional :: tran character, intent(in), optional :: tran
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: err_act, ldx, iix, jjx, nrow, imode, liwork,data_ integer(psb_ipk_) :: err_act, ldx, iix, jjx, nrow, imode, liwork,data_
integer(psb_lpk_) :: m, n, ix, ijx integer(psb_lpk_) :: m, n, ix, ijx
@ -283,10 +283,10 @@ subroutine psb_i2halov(x,desc_a,info,work,tran,mode,data)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -375,7 +375,7 @@ subroutine psb_i2halov(x,desc_a,info,work,tran,mode,data)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psb_i2halov end subroutine psb_i2halov

16
base/comm/psb_i2ovrl_a.f90
Unescape Escape View File

@ -76,7 +76,7 @@ subroutine psb_i2ovrlm(x,desc_a,info,jx,ik,work,update,mode)
integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me integer(psb_mpk_) :: np, me
integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, k, maxk, update_,& integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, k, maxk, update_,&
& mode_, liwork, ldx & mode_, liwork, ldx
@ -93,10 +93,10 @@ subroutine psb_i2ovrlm(x,desc_a,info,jx,ik,work,update,mode)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -188,7 +188,7 @@ subroutine psb_i2ovrlm(x,desc_a,info,jx,ik,work,update,mode)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psb_i2ovrlm end subroutine psb_i2ovrlm
@ -266,7 +266,7 @@ subroutine psb_i2ovrlv(x,desc_a,info,work,update,mode)
integer(psb_ipk_), intent(in), optional :: update,mode integer(psb_ipk_), intent(in), optional :: update,mode
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, iix, jjx, nrow, ncol, & integer(psb_ipk_) :: np, me, err_act, iix, jjx, nrow, ncol, &
& k, update_, mode_, liwork, ldx & k, update_, mode_, liwork, ldx
integer(psb_lpk_) :: m, n, ix, ijx integer(psb_lpk_) :: m, n, ix, ijx
@ -282,10 +282,10 @@ subroutine psb_i2ovrlv(x,desc_a,info,work,update,mode)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -370,7 +370,7 @@ subroutine psb_i2ovrlv(x,desc_a,info,work,update,mode)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psb_i2ovrlv end subroutine psb_i2ovrlv

28
base/comm/psb_i2scatter_a.F90
Unescape Escape View File

@ -62,7 +62,7 @@ subroutine psb_i2scatterm(globx, locx, desc_a, info, root)
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam, nlr integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam, nlr
integer(psb_ipk_) :: ierr(5), err_act, nrow,& integer(psb_ipk_) :: ierr(5), err_act, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, & & ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, &
@ -80,10 +80,10 @@ subroutine psb_i2scatterm(globx, locx, desc_a, info, root)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, iam, np) call psb_info(ctxt, iam, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -108,8 +108,8 @@ subroutine psb_i2scatterm(globx, locx, desc_a, info, root)
m = desc_a%get_global_rows() m = desc_a%get_global_rows()
n = desc_a%get_global_cols() n = desc_a%get_global_cols()
icomm = psb_get_mpi_comm(ictxt) icomm = psb_get_mpi_comm(ctxt)
myrank = psb_get_mpi_rank(ictxt,me) myrank = psb_get_mpi_rank(ctxt,me)
if (iroot==-1) then if (iroot==-1) then
lda_globx = size(globx, 1) lda_globx = size(globx, 1)
@ -160,7 +160,7 @@ subroutine psb_i2scatterm(globx, locx, desc_a, info, root)
end do end do
else else
rootrank = psb_get_mpi_rank(ictxt,iroot) rootrank = psb_get_mpi_rank(ctxt,iroot)
! !
! This is potentially unsafe when IPK=8 ! This is potentially unsafe when IPK=8
! But then, IPK=8 is highly experimental anyway. ! But then, IPK=8 is highly experimental anyway.
@ -236,7 +236,7 @@ subroutine psb_i2scatterm(globx, locx, desc_a, info, root)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
@ -307,7 +307,7 @@ subroutine psb_i2scatterv(globx, locx, desc_a, info, root)
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr
integer(psb_ipk_) :: ierr(5), err_act, nrow,& integer(psb_ipk_) :: ierr(5), err_act, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx
@ -324,13 +324,13 @@ subroutine psb_i2scatterv(globx, locx, desc_a, info, root)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, iam, np) call psb_info(ctxt, iam, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -349,8 +349,8 @@ subroutine psb_i2scatterv(globx, locx, desc_a, info, root)
iroot = psb_root_ iroot = psb_root_
end if end if
icomm = psb_get_mpi_comm(ictxt) icomm = psb_get_mpi_comm(ctxt)
myrank = psb_get_mpi_rank(ictxt,iam) myrank = psb_get_mpi_rank(ctxt,iam)
iglobx = 1 iglobx = 1
jglobx = 1 jglobx = 1
@ -396,7 +396,7 @@ subroutine psb_i2scatterv(globx, locx, desc_a, info, root)
locx(i)=globx(ltg(i)) locx(i)=globx(ltg(i))
end do end do
else else
rootrank = psb_get_mpi_rank(ictxt,iroot) rootrank = psb_get_mpi_rank(ctxt,iroot)
! !
! This is potentially unsafe when IPK=8 ! This is potentially unsafe when IPK=8
! But then, IPK=8 is highly experimental anyway. ! But then, IPK=8 is highly experimental anyway.
@ -474,7 +474,7 @@ subroutine psb_i2scatterv(globx, locx, desc_a, info, root)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return

20
base/comm/psb_igather.f90
Unescape Escape View File

@ -57,7 +57,7 @@ subroutine psb_igather_vect(globx, locx, desc_a, info, iroot)
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank
integer(psb_ipk_) :: ierr(5), err_act, jlx, ilx, lda_locx, lda_globx, i integer(psb_ipk_) :: ierr(5), err_act, jlx, ilx, lda_locx, lda_globx, i
integer(psb_lpk_) :: m, n, k, ilocx, jlocx, idx, iglobx, jglobx integer(psb_lpk_) :: m, n, k, ilocx, jlocx, idx, iglobx, jglobx
@ -71,10 +71,10 @@ subroutine psb_igather_vect(globx, locx, desc_a, info, iroot)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -149,12 +149,12 @@ subroutine psb_igather_vect(globx, locx, desc_a, info, iroot)
end if end if
end do end do
call psb_sum(ictxt,globx(1:m),root=root) call psb_sum(ctxt,globx(1:m),root=root)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
@ -175,7 +175,7 @@ subroutine psb_igather_multivect(globx, locx, desc_a, info, iroot)
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank
integer(psb_ipk_) :: ierr(5), err_act, jlx, ilx, lda_locx, lda_globx, i integer(psb_ipk_) :: ierr(5), err_act, jlx, ilx, lda_locx, lda_globx, i
integer(psb_lpk_) :: m, n, k, ilocx, jlocx, idx, iglobx, jglobx integer(psb_lpk_) :: m, n, k, ilocx, jlocx, idx, iglobx, jglobx
@ -189,10 +189,10 @@ subroutine psb_igather_multivect(globx, locx, desc_a, info, iroot)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -266,12 +266,12 @@ subroutine psb_igather_multivect(globx, locx, desc_a, info, iroot)
end if end if
end do end do
call psb_sum(ictxt,globx(1:m,1:k),root=root) call psb_sum(ctxt,globx(1:m,1:k),root=root)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return

16
base/comm/psb_ihalo.f90
Unescape Escape View File

@ -65,7 +65,7 @@ subroutine psb_ihalo_vect(x,desc_a,info,work,tran,mode,data)
character, intent(in), optional :: tran character, intent(in), optional :: tran
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, iix, jjx, & integer(psb_ipk_) :: np, me, err_act, iix, jjx, &
& nrow, ncol, lldx, imode, liwork,data_ & nrow, ncol, lldx, imode, liwork,data_
integer(psb_lpk_) :: m, n, ix, ijx integer(psb_lpk_) :: m, n, ix, ijx
@ -81,10 +81,10 @@ subroutine psb_ihalo_vect(x,desc_a,info,work,tran,mode,data)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -180,7 +180,7 @@ subroutine psb_ihalo_vect(x,desc_a,info,work,tran,mode,data)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psb_ihalo_vect end subroutine psb_ihalo_vect
@ -220,7 +220,7 @@ subroutine psb_ihalo_multivect(x,desc_a,info,work,tran,mode,data)
character, intent(in), optional :: tran character, intent(in), optional :: tran
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, iix, jjx, & integer(psb_ipk_) :: np, me, err_act, iix, jjx, &
& nrow, ncol, lldx, imode, liwork,data_ & nrow, ncol, lldx, imode, liwork,data_
integer(psb_lpk_) :: m, n, ix, ijx integer(psb_lpk_) :: m, n, ix, ijx
@ -236,10 +236,10 @@ subroutine psb_ihalo_multivect(x,desc_a,info,work,tran,mode,data)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -336,7 +336,7 @@ subroutine psb_ihalo_multivect(x,desc_a,info,work,tran,mode,data)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psb_ihalo_multivect end subroutine psb_ihalo_multivect

16
base/comm/psb_iovrl.f90
Unescape Escape View File

@ -75,7 +75,7 @@ subroutine psb_iovrl_vect(x,desc_a,info,work,update,mode)
integer(psb_ipk_), intent(in), optional :: update,mode integer(psb_ipk_), intent(in), optional :: update,mode
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, & integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, &
& nrow, ncol, ldx, liwork, data_, update_, mode_ & nrow, ncol, ldx, liwork, data_, update_, mode_
integer(psb_lpk_) :: m, n, ix, ijx integer(psb_lpk_) :: m, n, ix, ijx
@ -91,10 +91,10 @@ subroutine psb_iovrl_vect(x,desc_a,info,work,update,mode)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -176,7 +176,7 @@ subroutine psb_iovrl_vect(x,desc_a,info,work,update,mode)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psb_iovrl_vect end subroutine psb_iovrl_vect
@ -225,7 +225,7 @@ subroutine psb_iovrl_multivect(x,desc_a,info,work,update,mode)
integer(psb_ipk_), intent(in), optional :: update,mode integer(psb_ipk_), intent(in), optional :: update,mode
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, & integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, &
& nrow, ncol, ldx, liwork, data_, update_, mode_ & nrow, ncol, ldx, liwork, data_, update_, mode_
integer(psb_lpk_) :: m, n, ix, ijx integer(psb_lpk_) :: m, n, ix, ijx
@ -241,10 +241,10 @@ subroutine psb_iovrl_multivect(x,desc_a,info,work,update,mode)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -328,7 +328,7 @@ subroutine psb_iovrl_multivect(x,desc_a,info,work,update,mode)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psb_iovrl_multivect end subroutine psb_iovrl_multivect

8
base/comm/psb_iscatter.F90
Unescape Escape View File

@ -54,7 +54,7 @@ subroutine psb_iscatter_vect(globx, locx, desc_a, info, root, mold)
class(psb_i_base_vect_type), intent(in), optional :: mold class(psb_i_base_vect_type), intent(in), optional :: mold
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me, icomm, myrank, rootrank integer(psb_mpk_) :: np, me, icomm, myrank, rootrank
integer(psb_ipk_) :: ierr(5), err_act, m, n, i, j, idx, nrow, iglobx, jglobx,& integer(psb_ipk_) :: ierr(5), err_act, m, n, i, j, idx, nrow, iglobx, jglobx,&
& ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx
@ -68,13 +68,13 @@ subroutine psb_iscatter_vect(globx, locx, desc_a, info, root, mold)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -93,7 +93,7 @@ subroutine psb_iscatter_vect(globx, locx, desc_a, info, root, mold)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return

30
base/comm/psb_ispgather.F90
Unescape Escape View File

@ -67,7 +67,7 @@ subroutine psb_isp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
integer(psb_ipk_) :: err_act, dupl_ integer(psb_ipk_) :: err_act, dupl_
integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k
logical :: keepnum_, keeploc_ logical :: keepnum_, keeploc_
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me integer(psb_mpk_) :: np, me
integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_) :: icomm, minfo, ndx, root_
integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_mpk_), allocatable :: nzbr(:), idisp(:)
@ -83,9 +83,9 @@ subroutine psb_isp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (present(keepnum)) then if (present(keepnum)) then
keepnum_ = keepnum keepnum_ = keepnum
@ -129,7 +129,7 @@ subroutine psb_isp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
call psb_loc_to_glob(loc_coo%ja(1:nzl),locja(1:nzl),desc_a,info,iact='I') call psb_loc_to_glob(loc_coo%ja(1:nzl),locja(1:nzl),desc_a,info,iact='I')
nzbr(:) = 0 nzbr(:) = 0
nzbr(me+1) = nzl nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np)) call psb_sum(ctxt,nzbr(1:np))
nzg = sum(nzbr) nzg = sum(nzbr)
if (nzg <0) then if (nzg <0) then
info = psb_err_mpi_int_ovflw_ info = psb_err_mpi_int_ovflw_
@ -217,7 +217,7 @@ subroutine psb_isp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
9999 continue 9999 continue
call psb_errpush(info,name) call psb_errpush(info,name)
call psb_error_handler(ictxt,err_act) call psb_error_handler(ctxt,err_act)
return return
@ -250,7 +250,7 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
integer(psb_ipk_) :: err_act, dupl_ integer(psb_ipk_) :: err_act, dupl_
integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl
logical :: keepnum_, keeploc_ logical :: keepnum_, keeploc_
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_) :: icomm, minfo, ndx, root_
integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_mpk_), allocatable :: nzbr(:), idisp(:)
@ -266,9 +266,9 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (present(keepnum)) then if (present(keepnum)) then
keepnum_ = keepnum keepnum_ = keepnum
@ -310,7 +310,7 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
call psb_loc_to_glob(loc_coo%ja(1:nzl),desc_a,info,iact='I') call psb_loc_to_glob(loc_coo%ja(1:nzl),desc_a,info,iact='I')
nzbr(:) = 0 nzbr(:) = 0
nzbr(me+1) = nzl nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np)) call psb_sum(ctxt,nzbr(1:np))
lnzbr = nzbr lnzbr = nzbr
nzg = sum(nzbr) nzg = sum(nzbr)
if ((nzg < 0).or.(nzg /= sum(lnzbr))) then if ((nzg < 0).or.(nzg /= sum(lnzbr))) then
@ -390,7 +390,7 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
9999 continue 9999 continue
call psb_errpush(info,name) call psb_errpush(info,name)
call psb_error_handler(ictxt,err_act) call psb_error_handler(ctxt,err_act)
return return
@ -422,7 +422,7 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn
integer(psb_ipk_) :: err_act, dupl_ integer(psb_ipk_) :: err_act, dupl_
integer(psb_lpk_) :: ip,naggrm1,naggrp1, i, j, k, nzl integer(psb_lpk_) :: ip,naggrm1,naggrp1, i, j, k, nzl
logical :: keepnum_, keeploc_ logical :: keepnum_, keeploc_
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me integer(psb_ipk_) :: np, me
integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_) :: icomm, minfo, ndx, root_
integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_mpk_), allocatable :: nzbr(:), idisp(:)
@ -438,9 +438,9 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (present(keepnum)) then if (present(keepnum)) then
keepnum_ = keepnum keepnum_ = keepnum
@ -482,7 +482,7 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn
call psb_loc_to_glob(loc_coo%ja(1:nzl),desc_a,info,iact='I') call psb_loc_to_glob(loc_coo%ja(1:nzl),desc_a,info,iact='I')
nzbr(:) = 0 nzbr(:) = 0
nzbr(me+1) = nzl nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np)) call psb_sum(ctxt,nzbr(1:np))
lnzbr = nzbr lnzbr = nzbr
nzg = sum(nzbr) nzg = sum(nzbr)
if ((nzg < 0).or.(nzg /= sum(lnzbr))) then if ((nzg < 0).or.(nzg /= sum(lnzbr))) then
@ -557,7 +557,7 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn
9999 continue 9999 continue
call psb_errpush(info,name) call psb_errpush(info,name)
call psb_error_handler(ictxt,err_act) call psb_error_handler(ctxt,err_act)
return return

20
base/comm/psb_lgather.f90
Unescape Escape View File

@ -57,7 +57,7 @@ subroutine psb_lgather_vect(globx, locx, desc_a, info, iroot)
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank
integer(psb_ipk_) :: ierr(5), err_act, jlx, ilx, lda_locx, lda_globx, i integer(psb_ipk_) :: ierr(5), err_act, jlx, ilx, lda_locx, lda_globx, i
integer(psb_lpk_) :: m, n, k, ilocx, jlocx, idx, iglobx, jglobx integer(psb_lpk_) :: m, n, k, ilocx, jlocx, idx, iglobx, jglobx
@ -71,10 +71,10 @@ subroutine psb_lgather_vect(globx, locx, desc_a, info, iroot)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -149,12 +149,12 @@ subroutine psb_lgather_vect(globx, locx, desc_a, info, iroot)
end if end if
end do end do
call psb_sum(ictxt,globx(1:m),root=root) call psb_sum(ctxt,globx(1:m),root=root)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
@ -175,7 +175,7 @@ subroutine psb_lgather_multivect(globx, locx, desc_a, info, iroot)
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank
integer(psb_ipk_) :: ierr(5), err_act, jlx, ilx, lda_locx, lda_globx, i integer(psb_ipk_) :: ierr(5), err_act, jlx, ilx, lda_locx, lda_globx, i
integer(psb_lpk_) :: m, n, k, ilocx, jlocx, idx, iglobx, jglobx integer(psb_lpk_) :: m, n, k, ilocx, jlocx, idx, iglobx, jglobx
@ -189,10 +189,10 @@ subroutine psb_lgather_multivect(globx, locx, desc_a, info, iroot)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -266,12 +266,12 @@ subroutine psb_lgather_multivect(globx, locx, desc_a, info, iroot)
end if end if
end do end do
call psb_sum(ictxt,globx(1:m,1:k),root=root) call psb_sum(ctxt,globx(1:m,1:k),root=root)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return

16
base/comm/psb_lhalo.f90
Unescape Escape View File

@ -65,7 +65,7 @@ subroutine psb_lhalo_vect(x,desc_a,info,work,tran,mode,data)
character, intent(in), optional :: tran character, intent(in), optional :: tran
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, iix, jjx, & integer(psb_ipk_) :: np, me, err_act, iix, jjx, &
& nrow, ncol, lldx, imode, liwork,data_ & nrow, ncol, lldx, imode, liwork,data_
integer(psb_lpk_) :: m, n, ix, ijx integer(psb_lpk_) :: m, n, ix, ijx
@ -81,10 +81,10 @@ subroutine psb_lhalo_vect(x,desc_a,info,work,tran,mode,data)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -180,7 +180,7 @@ subroutine psb_lhalo_vect(x,desc_a,info,work,tran,mode,data)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psb_lhalo_vect end subroutine psb_lhalo_vect
@ -220,7 +220,7 @@ subroutine psb_lhalo_multivect(x,desc_a,info,work,tran,mode,data)
character, intent(in), optional :: tran character, intent(in), optional :: tran
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, iix, jjx, & integer(psb_ipk_) :: np, me, err_act, iix, jjx, &
& nrow, ncol, lldx, imode, liwork,data_ & nrow, ncol, lldx, imode, liwork,data_
integer(psb_lpk_) :: m, n, ix, ijx integer(psb_lpk_) :: m, n, ix, ijx
@ -236,10 +236,10 @@ subroutine psb_lhalo_multivect(x,desc_a,info,work,tran,mode,data)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -336,7 +336,7 @@ subroutine psb_lhalo_multivect(x,desc_a,info,work,tran,mode,data)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psb_lhalo_multivect end subroutine psb_lhalo_multivect

16
base/comm/psb_lovrl.f90
Unescape Escape View File

@ -75,7 +75,7 @@ subroutine psb_lovrl_vect(x,desc_a,info,work,update,mode)
integer(psb_ipk_), intent(in), optional :: update,mode integer(psb_ipk_), intent(in), optional :: update,mode
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, & integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, &
& nrow, ncol, ldx, liwork, data_, update_, mode_ & nrow, ncol, ldx, liwork, data_, update_, mode_
integer(psb_lpk_) :: m, n, ix, ijx integer(psb_lpk_) :: m, n, ix, ijx
@ -91,10 +91,10 @@ subroutine psb_lovrl_vect(x,desc_a,info,work,update,mode)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -176,7 +176,7 @@ subroutine psb_lovrl_vect(x,desc_a,info,work,update,mode)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psb_lovrl_vect end subroutine psb_lovrl_vect
@ -225,7 +225,7 @@ subroutine psb_lovrl_multivect(x,desc_a,info,work,update,mode)
integer(psb_ipk_), intent(in), optional :: update,mode integer(psb_ipk_), intent(in), optional :: update,mode
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, & integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, &
& nrow, ncol, ldx, liwork, data_, update_, mode_ & nrow, ncol, ldx, liwork, data_, update_, mode_
integer(psb_lpk_) :: m, n, ix, ijx integer(psb_lpk_) :: m, n, ix, ijx
@ -241,10 +241,10 @@ subroutine psb_lovrl_multivect(x,desc_a,info,work,update,mode)
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -328,7 +328,7 @@ subroutine psb_lovrl_multivect(x,desc_a,info,work,update,mode)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return
end subroutine psb_lovrl_multivect end subroutine psb_lovrl_multivect

8
base/comm/psb_lscatter.F90
Unescape Escape View File

@ -54,7 +54,7 @@ subroutine psb_lscatter_vect(globx, locx, desc_a, info, root, mold)
class(psb_l_base_vect_type), intent(in), optional :: mold class(psb_l_base_vect_type), intent(in), optional :: mold
! locals ! locals
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: np, me, icomm, myrank, rootrank integer(psb_mpk_) :: np, me, icomm, myrank, rootrank
integer(psb_ipk_) :: ierr(5), err_act, m, n, i, j, idx, nrow, iglobx, jglobx,& integer(psb_ipk_) :: ierr(5), err_act, m, n, i, j, idx, nrow, iglobx, jglobx,&
& ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx
@ -68,13 +68,13 @@ subroutine psb_lscatter_vect(globx, locx, desc_a, info, root, mold)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
end if end if
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ctxt, me, np)
if (np == -1) then if (np == -1) then
info = psb_err_context_error_ info = psb_err_context_error_
call psb_errpush(info,name) call psb_errpush(info,name)
@ -93,7 +93,7 @@ subroutine psb_lscatter_vect(globx, locx, desc_a, info, root, mold)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ctxt,err_act)
return return

Some files were not shown because too many files have changed in this diff Show More

Write Preview
Loading…
Cancel
Save