|
|
@ -67,7 +67,7 @@ subroutine psb_chalo_vect(x,desc_a,info,work,tran,mode,data)
|
|
|
|
|
|
|
|
|
|
|
|
! locals
|
|
|
|
! locals
|
|
|
|
integer(psb_ipk_) :: ictxt, np, me, err_act, iix, jjx, &
|
|
|
|
integer(psb_ipk_) :: ictxt, np, me, err_act, iix, jjx, &
|
|
|
|
& nrow, imode, err, liwork,data_
|
|
|
|
& nrow, ncol, lldx, imode, err, liwork,data_
|
|
|
|
integer(psb_lpk_) :: m, n, ix, ijx
|
|
|
|
integer(psb_lpk_) :: m, n, ix, ijx
|
|
|
|
complex(psb_spk_),pointer :: iwork(:)
|
|
|
|
complex(psb_spk_),pointer :: iwork(:)
|
|
|
|
character :: tran_
|
|
|
|
character :: tran_
|
|
|
@ -98,11 +98,12 @@ subroutine psb_chalo_vect(x,desc_a,info,work,tran,mode,data)
|
|
|
|
endif
|
|
|
|
endif
|
|
|
|
|
|
|
|
|
|
|
|
ix = 1
|
|
|
|
ix = 1
|
|
|
|
ijx = 1
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
m = desc_a%get_global_rows()
|
|
|
|
m = desc_a%get_global_rows()
|
|
|
|
n = desc_a%get_global_cols()
|
|
|
|
n = desc_a%get_global_cols()
|
|
|
|
nrow = desc_a%get_local_rows()
|
|
|
|
nrow = desc_a%get_local_rows()
|
|
|
|
|
|
|
|
ncol = desc_a%get_local_cols()
|
|
|
|
|
|
|
|
lldx = x%get_nrows()
|
|
|
|
|
|
|
|
|
|
|
|
if (present(tran)) then
|
|
|
|
if (present(tran)) then
|
|
|
|
tran_ = psb_toupper(tran)
|
|
|
|
tran_ = psb_toupper(tran)
|
|
|
@ -120,23 +121,14 @@ subroutine psb_chalo_vect(x,desc_a,info,work,tran,mode,data)
|
|
|
|
imode = IOR(psb_swap_send_,psb_swap_recv_)
|
|
|
|
imode = IOR(psb_swap_send_,psb_swap_recv_)
|
|
|
|
endif
|
|
|
|
endif
|
|
|
|
|
|
|
|
|
|
|
|
! check vector correctness
|
|
|
|
if ((info == 0).and.(lldx<ncol)) call x%reall(ncol,info)
|
|
|
|
call psb_chkvect(m,lone,x%get_nrows(),ix,ijx,desc_a,info,iix,jjx)
|
|
|
|
|
|
|
|
if(info /= psb_success_) then
|
|
|
|
if(info /= psb_success_) then
|
|
|
|
info=psb_err_from_subroutine_
|
|
|
|
info=psb_err_from_subroutine_ ; ch_err='reall'
|
|
|
|
ch_err='psb_chkvect'
|
|
|
|
|
|
|
|
call psb_errpush(info,name,a_err=ch_err)
|
|
|
|
call psb_errpush(info,name,a_err=ch_err)
|
|
|
|
|
|
|
|
goto 9999
|
|
|
|
end if
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
|
|
if (iix /= 1) then
|
|
|
|
|
|
|
|
info=psb_err_ix_n1_iy_n1_unsupported_
|
|
|
|
|
|
|
|
call psb_errpush(info,name)
|
|
|
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
err=info
|
|
|
|
|
|
|
|
call psb_errcomm(ictxt,err)
|
|
|
|
|
|
|
|
if(err /= 0) goto 9999
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
liwork=nrow
|
|
|
|
liwork=nrow
|
|
|
|
if (present(work)) then
|
|
|
|
if (present(work)) then
|
|
|
|
if(size(work) >= liwork) then
|
|
|
|
if(size(work) >= liwork) then
|
|
|
@ -208,7 +200,7 @@ subroutine psb_chalo_multivect(x,desc_a,info,work,tran,mode,data)
|
|
|
|
|
|
|
|
|
|
|
|
! locals
|
|
|
|
! locals
|
|
|
|
integer(psb_ipk_) :: ictxt, np, me, err_act, iix, jjx, &
|
|
|
|
integer(psb_ipk_) :: ictxt, np, me, err_act, iix, jjx, &
|
|
|
|
& nrow, imode, err, liwork,data_
|
|
|
|
& nrow, ncol, lldx, imode, err, liwork,data_
|
|
|
|
integer(psb_lpk_) :: m, n, ix, ijx
|
|
|
|
integer(psb_lpk_) :: m, n, ix, ijx
|
|
|
|
complex(psb_spk_),pointer :: iwork(:)
|
|
|
|
complex(psb_spk_),pointer :: iwork(:)
|
|
|
|
character :: tran_
|
|
|
|
character :: tran_
|
|
|
@ -244,6 +236,8 @@ subroutine psb_chalo_multivect(x,desc_a,info,work,tran,mode,data)
|
|
|
|
m = desc_a%get_global_rows()
|
|
|
|
m = desc_a%get_global_rows()
|
|
|
|
n = desc_a%get_global_cols()
|
|
|
|
n = desc_a%get_global_cols()
|
|
|
|
nrow = desc_a%get_local_rows()
|
|
|
|
nrow = desc_a%get_local_rows()
|
|
|
|
|
|
|
|
ncol = desc_a%get_local_cols()
|
|
|
|
|
|
|
|
lldx = x%get_nrows()
|
|
|
|
|
|
|
|
|
|
|
|
if (present(tran)) then
|
|
|
|
if (present(tran)) then
|
|
|
|
tran_ = psb_toupper(tran)
|
|
|
|
tran_ = psb_toupper(tran)
|
|
|
@ -261,23 +255,14 @@ subroutine psb_chalo_multivect(x,desc_a,info,work,tran,mode,data)
|
|
|
|
imode = IOR(psb_swap_send_,psb_swap_recv_)
|
|
|
|
imode = IOR(psb_swap_send_,psb_swap_recv_)
|
|
|
|
endif
|
|
|
|
endif
|
|
|
|
|
|
|
|
|
|
|
|
! check vector correctness
|
|
|
|
if (lldx < ncol) call x%reall(ncol,x%get_ncols(),info)
|
|
|
|
call psb_chkvect(m,lone,x%get_nrows(),ix,ijx,desc_a,info,iix,jjx)
|
|
|
|
|
|
|
|
if(info /= psb_success_) then
|
|
|
|
if(info /= psb_success_) then
|
|
|
|
info=psb_err_from_subroutine_
|
|
|
|
info=psb_err_from_subroutine_; ch_err='psb_reall'
|
|
|
|
ch_err='psb_chkvect'
|
|
|
|
|
|
|
|
call psb_errpush(info,name,a_err=ch_err)
|
|
|
|
call psb_errpush(info,name,a_err=ch_err)
|
|
|
|
|
|
|
|
goto 9999
|
|
|
|
end if
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
|
|
if (iix /= 1) then
|
|
|
|
|
|
|
|
info=psb_err_ix_n1_iy_n1_unsupported_
|
|
|
|
|
|
|
|
call psb_errpush(info,name)
|
|
|
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
err=info
|
|
|
|
|
|
|
|
call psb_errcomm(ictxt,err)
|
|
|
|
|
|
|
|
if(err /= 0) goto 9999
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
liwork=nrow
|
|
|
|
liwork=nrow
|
|
|
|
if (present(work)) then
|
|
|
|
if (present(work)) then
|
|
|
|
if(size(work) >= liwork) then
|
|
|
|
if(size(work) >= liwork) then
|
|
|
|