From 31613d98a0fffcbc97b5347ca877e877ad4bf226 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Tue, 3 Jan 2012 20:52:00 +0000 Subject: [PATCH] *** empty log message *** --- mlprec/mld_c_diag_solver.f90 | 211 ++++++++++++++++++++++++----------- 1 file changed, 145 insertions(+), 66 deletions(-) diff --git a/mlprec/mld_c_diag_solver.f90 b/mlprec/mld_c_diag_solver.f90 index 38100cc5..8d68b864 100644 --- a/mlprec/mld_c_diag_solver.f90 +++ b/mlprec/mld_c_diag_solver.f90 @@ -126,7 +126,7 @@ contains goto 9999 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 call psb_errpush(psb_err_from_subroutine_,name,a_err='vect%mlt') @@ -179,80 +179,159 @@ contains n_row = desc_data%get_local_rows() n_col = desc_data%get_local_cols() - 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 + 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) = conjg(sv%d(i)) * x(i) + end do + else if (alpha == -cone) then + do i=1, n_row + y(i) = -conjg(sv%d(i)) * x(i) + end do + else + do i=1, n_row + y(i) = alpha * conjg(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) = 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 - 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 + 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) = conjg(sv%d(i)) * x(i) + beta*y(i) + end do + else if (alpha == -cone) then + do i=1, n_row + y(i) = -conjg(sv%d(i)) * x(i) + beta*y(i) + end do + else + do i=1, n_row + y(i) = alpha * conjg(sv%d(i)) * x(i) + beta*y(i) + end do + end if + end if - else - - 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 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 + else - do i=1, n_row - y(i) = alpha * sv%d(i) * x(i) + beta*y(i) - end do + + 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 + do i=1, n_row + y(i) = alpha * sv%d(i) * x(i) + beta*y(i) + end do + end if + end if end if - + call psb_erractionrestore(err_act) return