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

*** empty log message ***

Browse Source
stopcriterion
Salvatore Filippone 13 years ago
parent 4dce038d6e
commit 31613d98a0
1 changed files with 145 additions and 66 deletions
Show Stats Download Patch File Download Diff File

207
mlprec/mld_c_diag_solver.f90
Unescape Escape View File

@ -126,7 +126,7 @@ contains
goto 9999 goto 9999
end if end if
call y%mlt(alpha,sv%dv,x,beta,info) call y%mlt(alpha,sv%dv,x,beta,info,trans=trans_)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='vect%mlt') call psb_errpush(psb_err_from_subroutine_,name,a_err='vect%mlt')
@ -179,76 +179,155 @@ contains
n_row = desc_data%get_local_rows() n_row = desc_data%get_local_rows()
n_col = desc_data%get_local_cols() n_col = desc_data%get_local_cols()
if (beta == czero) then if (trans_ == 'C') then
if (beta == czero) then
if (alpha == czero) then
y(1:n_row) = czero if (alpha == czero) then
else if (alpha == cone) then y(1:n_row) = czero
do i=1, n_row else if (alpha == cone) then
y(i) = sv%d(i) * x(i) do i=1, n_row
end do y(i) = conjg(sv%d(i)) * x(i)
else if (alpha == -cone) then end do
do i=1, n_row else if (alpha == -cone) then
y(i) = -sv%d(i) * x(i) do i=1, n_row
end do y(i) = -conjg(sv%d(i)) * x(i)
else end do
do i=1, n_row else
y(i) = alpha * sv%d(i) * x(i) do i=1, n_row
end do y(i) = alpha * conjg(sv%d(i)) * x(i)
end if end do
end if
else if (beta == cone) then
if (alpha == czero) then
!y(1:n_row) = czero
else if (alpha == cone) then
do i=1, n_row
y(i) = conjg(sv%d(i)) * x(i) + y(i)
end do
else if (alpha == -cone) then
do i=1, n_row
y(i) = -conjg(sv%d(i)) * x(i) + y(i)
end do
else
do i=1, n_row
y(i) = alpha * conjg(sv%d(i)) * x(i) + y(i)
end do
end if
else if (beta == -cone) then
if (alpha == czero) then
y(1:n_row) = -y(1:n_row)
else if (alpha == cone) then
do i=1, n_row
y(i) = conjg(sv%d(i)) * x(i) - y(i)
end do
else if (alpha == -cone) then
do i=1, n_row
y(i) = -conjg(sv%d(i)) * x(i) - y(i)
end do
else
do i=1, n_row
y(i) = alpha * conjg(sv%d(i)) * x(i) - y(i)
end do
end if
else if (beta == cone) then
if (alpha == czero) then
!y(1:n_row) = czero
else if (alpha == cone) then
do i=1, n_row
y(i) = sv%d(i) * x(i) + y(i)
end do
else if (alpha == -cone) then
do i=1, n_row
y(i) = -sv%d(i) * x(i) + y(i)
end do
else else
do i=1, n_row
y(i) = alpha * sv%d(i) * x(i) + y(i)
end do
end if
else if (beta == -cone) then if (alpha == czero) then
y(1:n_row) = beta *y(1:n_row)
if (alpha == czero) then else if (alpha == cone) then
y(1:n_row) = -y(1:n_row) do i=1, n_row
else if (alpha == cone) then y(i) = conjg(sv%d(i)) * x(i) + beta*y(i)
do i=1, n_row end do
y(i) = sv%d(i) * x(i) - y(i) else if (alpha == -cone) then
end do do i=1, n_row
else if (alpha == -cone) then y(i) = -conjg(sv%d(i)) * x(i) + beta*y(i)
do i=1, n_row end do
y(i) = -sv%d(i) * x(i) - y(i) else
end do do i=1, n_row
else y(i) = alpha * conjg(sv%d(i)) * x(i) + beta*y(i)
do i=1, n_row end do
y(i) = alpha * sv%d(i) * x(i) - y(i) end if
end do
end if end if
else else if (trans_ /= 'C') then
if (beta == czero) then
if (alpha == czero) then
y(1:n_row) = czero
else if (alpha == cone) then
do i=1, n_row
y(i) = sv%d(i) * x(i)
end do
else if (alpha == -cone) then
do i=1, n_row
y(i) = -sv%d(i) * x(i)
end do
else
do i=1, n_row
y(i) = alpha * sv%d(i) * x(i)
end do
end if
else if (beta == cone) then
if (alpha == czero) then
!y(1:n_row) = czero
else if (alpha == cone) then
do i=1, n_row
y(i) = sv%d(i) * x(i) + y(i)
end do
else if (alpha == -cone) then
do i=1, n_row
y(i) = -sv%d(i) * x(i) + y(i)
end do
else
do i=1, n_row
y(i) = alpha * sv%d(i) * x(i) + y(i)
end do
end if
else if (beta == -cone) then
if (alpha == czero) then
y(1:n_row) = -y(1:n_row)
else if (alpha == cone) then
do i=1, n_row
y(i) = sv%d(i) * x(i) - y(i)
end do
else if (alpha == -cone) then
do i=1, n_row
y(i) = -sv%d(i) * x(i) - y(i)
end do
else
do i=1, n_row
y(i) = alpha * sv%d(i) * x(i) - y(i)
end do
end if
if (alpha == czero) then
y(1:n_row) = beta *y(1:n_row)
else if (alpha == cone) then
do i=1, n_row
y(i) = sv%d(i) * x(i) + beta*y(i)
end do
else if (alpha == -cone) then
do i=1, n_row
y(i) = -sv%d(i) * x(i) + beta*y(i)
end do
else else
do i=1, n_row
y(i) = alpha * sv%d(i) * x(i) + beta*y(i) if (alpha == czero) then
end do y(1:n_row) = beta *y(1:n_row)
else if (alpha == cone) then
do i=1, n_row
y(i) = sv%d(i) * x(i) + beta*y(i)
end do
else if (alpha == -cone) then
do i=1, n_row
y(i) = -sv%d(i) * x(i) + beta*y(i)
end do
else
do i=1, n_row
y(i) = alpha * sv%d(i) * x(i) + beta*y(i)
end do
end if
end if end if
end if end if

Write Preview
Loading…
Cancel
Save