diff --git a/base/comm/psb_ihalo.f90 b/base/comm/psb_ihalo.f90 index 49d39888..c1c32253 100644 --- a/base/comm/psb_ihalo.f90 +++ b/base/comm/psb_ihalo.f90 @@ -59,6 +59,7 @@ subroutine psb_ihalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data) use psb_check_mod use psb_realloc_mod use psb_error_mod + use psb_string_mod use psb_penv_mod implicit none @@ -286,6 +287,7 @@ subroutine psb_ihalov(x,desc_a,info,alpha,work,tran,mode,data) use psb_check_mod use psb_realloc_mod use psb_error_mod + use psb_string_mod use psb_penv_mod implicit none diff --git a/base/comm/psb_zhalo.f90 b/base/comm/psb_zhalo.f90 index af526eab..fa2e6373 100644 --- a/base/comm/psb_zhalo.f90 +++ b/base/comm/psb_zhalo.f90 @@ -58,6 +58,7 @@ subroutine psb_zhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data) use psb_check_mod use psb_realloc_mod use psb_error_mod + use psb_string_mod use psb_penv_mod implicit none @@ -283,6 +284,7 @@ subroutine psb_zhalov(x,desc_a,info,alpha,work,tran,mode,data) use psb_check_mod use psb_realloc_mod use psb_error_mod + use psb_string_mod use psb_penv_mod implicit none diff --git a/base/modules/psb_psblas_mod.f90 b/base/modules/psb_psblas_mod.f90 index 85eb62e6..e8dd0bfa 100644 --- a/base/modules/psb_psblas_mod.f90 +++ b/base/modules/psb_psblas_mod.f90 @@ -78,14 +78,6 @@ module psb_psblas_mod type(psb_desc_type), intent(in) :: desc_a integer, intent(out) :: info end subroutine psb_dmdots - - subroutine psb_ddot2v(res, x, y,w,z,desc_a, info) - use psb_descriptor_type - real(kind(1.d0)), intent(in) :: x(:), y(:),w(:), z(:) - real(kind(1.d0)), intent(out) :: res(:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - end subroutine psb_ddot2v subroutine psb_zdotvs(res,x, y, desc_a, info) use psb_descriptor_type complex(kind(1.d0)), intent(out) :: res diff --git a/base/psblas/psb_damax.f90 b/base/psblas/psb_damax.f90 index 8d657ed2..0d0c6f75 100644 --- a/base/psblas/psb_damax.f90 +++ b/base/psblas/psb_damax.f90 @@ -38,7 +38,7 @@ ! where sub( X ) denotes X(1:N,JX:). ! ! Arguments: -! x - real,dimension(:,:). The input vector. +! x(:,:) - real The input vector. ! desc_a - type(psb_desc_type). The communication descriptor. ! info - integer. Return code ! jx - integer(optional). The column offset. @@ -159,13 +159,14 @@ end function psb_damax !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ +! ! Function: psb_damaxv ! Searches the absolute max of X. ! ! normi := max(abs(X(i)) ! ! Arguments: -! x - real,dimension(:). The input vector. +! x(:) - real The input vector. ! desc_a - type(psb_desc_type). The communication descriptor. ! info - integer. Return code ! @@ -287,7 +288,7 @@ end function psb_damaxv ! ! Arguments: ! res - real. The result. -! x - real,dimension(:,:). The input vector. +! x(:,:) - real The input vector. ! desc_a - type(psb_desc_type). The communication descriptor. ! info - integer. Return code ! jx - integer(optional). The column offset. @@ -408,10 +409,10 @@ end subroutine psb_damaxvs ! normi := max(abs(X(i)) ! ! Arguments: -! res - real. The result. -! x - real,dimension(:). The input vector. +! res(:) - real The result. +! x(:,:) - real The input vector. ! desc_a - type(psb_desc_type). The communication descriptor. -! info - integer. Return code +! info - integer. Return code ! subroutine psb_dmamaxs (res,x,desc_a, info,jx) use psb_penv_mod diff --git a/base/psblas/psb_dasum.f90 b/base/psblas/psb_dasum.f90 index 7a24444c..d4fc9853 100644 --- a/base/psblas/psb_dasum.f90 +++ b/base/psblas/psb_dasum.f90 @@ -38,10 +38,10 @@ ! where sub( X ) denotes X(1:N,JX:). ! ! Arguments: -! x - real,dimension(:,:). The input vector. +! x(:,:) - real The input vector. ! desc_a - type(psb_desc_type). The communication descriptor. -! info - integer. Return code -! jx - integer(optional). The column offset. +! info - integer. Return code +! jx - integer(optional). The column offset. ! function psb_dasum (x,desc_a, info, jx) @@ -177,13 +177,14 @@ end function psb_dasum !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ +! ! Function: psb_dasumv ! Computes norm1 of X ! ! norm1 := sum(X(i)) ! ! Arguments: -! x - real,dimension(:). The input vector. +! x(:) - real The input vector. ! desc_a - type(psb_desc_type). The communication descriptor. ! info - integer. Return code ! @@ -314,19 +315,20 @@ end function psb_dasumv !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -! Subroutine: psb_dasum vs +! +! Subroutine: psb_dasumvs ! Computes norm1 of X ! ! norm1 := sum(X(i)) ! ! Arguments: -! res - real. The result. -! x - real,dimension(:). The input vector. +! res - real The result. +! x(:) - real The input vector. ! desc_a - type(psb_desc_type). The communication descriptor. ! info - integer. Return code ! jx - integer(optional). The column offset. ! -subroutine psb_dasumvs (res,x,desc_a, info) +subroutine psb_dasumvs(res,x,desc_a, info) use psb_serial_mod use psb_descriptor_type use psb_check_mod diff --git a/base/psblas/psb_daxpby.f90 b/base/psblas/psb_daxpby.f90 index 1b3b7fe7..1defa80b 100644 --- a/base/psblas/psb_daxpby.f90 +++ b/base/psblas/psb_daxpby.f90 @@ -40,14 +40,14 @@ ! sub( Y ) denotes Y(:,JY). ! ! Arguments: -! alpha - real. The scalar used to multiply each component of sub( X ). -! x - real,dimension(:,:). The input vector containing the entries of sub( X ). -! beta - real. The scalar used to multiply each component of sub( Y ). -! y - real,dimension(:,:). The input vector containing the entries of sub( Y ). -! desc_a - type(psb_desc_type). The communication descriptor. -! info - integer. Return code -! jx - integer(optional). The column offset for sub( X ). -! jy - integer(optional). The column offset for sub( Y ). +! alpha - real The scalar alpha +! x(:,:) - real The input vector containing the entries of ( X ). +! beta - real The scalar beta +! y(:,:) - real The input vector containing the entries of ( Y ). +! desc_a - type(psb_desc_type). The communication descriptor. +! info - integer. Return code +! jx - integer(optional). The column offset for sub( X ). +! jy - integer(optional). The column offset for sub( Y ). ! subroutine psb_daxpby(alpha, x, beta,y,desc_a,info, n, jx, jy) use psb_descriptor_type @@ -189,18 +189,19 @@ end subroutine psb_daxpby !!$ !!$ ! -! Subroutine: psb_dgeaxpbyv +! Subroutine: psb_daxpbyv ! Adds one distributed matrix to another, ! ! Y := beta * Y + alpha * X ! ! Arguments: -! alpha - real. The scalar used to multiply each component of X. -! x - real,dimension(:). The input vector containing the entries of X. -! beta - real. The scalar used to multiply each component of Y. -! y - real,dimension(:). The input vector containing the entries of Y. -! desc_a - type(psb_desc_type). The communication descriptor. -! info - integer. Return code +! alpha - real The scalar alpha +! x(:) - real The input vector containing the entries of ( X ). +! beta - real The scalar beta +! y(:) - real The input vector containing the entries of ( Y ). +! desc_a - type(psb_desc_type). The communication descriptor. +! info - integer. Return code +! ! subroutine psb_daxpbyv(alpha, x, beta,y,desc_a,info) use psb_descriptor_type diff --git a/base/psblas/psb_ddot.f90 b/base/psblas/psb_ddot.f90 index 9616bc7a..8c5da986 100644 --- a/base/psblas/psb_ddot.f90 +++ b/base/psblas/psb_ddot.f90 @@ -40,12 +40,12 @@ ! sub( Y ) denotes Y(:,JY). ! ! Arguments: -! x - real,dimension(:,:). The input vector containing the entries of sub( X ). -! y - real,dimension(:,:). The input vector containing the entries of sub( Y ). -! desc_a - type(psb_desc_type). The communication descriptor. -! info - integer. Return code -! jx - integer(optional). The column offset for sub( X ). -! jy - integer(optional). The column offset for sub( Y ). +! x(:,:) - real The input vector containing the entries of ( X ). +! y(:,:) - real The input vector containing the entries of ( Y ). +! desc_a - type(psb_desc_type). The communication descriptor. +! info - integer. Return code +! jx - integer(optional). The column offset for sub( X ). +! jy - integer(optional). The column offset for sub( Y ). ! function psb_ddot(x, y,desc_a, info, jx, jy) use psb_descriptor_type @@ -190,17 +190,18 @@ end function psb_ddot !!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE !!$ POSSIBILITY OF SUCH DAMAGE. !!$ -!!$ +!!$ +! ! Function: psb_ddotv -! psb_ddot forms the dot product of two distributed vectors, +! psb_ddotv forms the dot product of two distributed vectors, ! ! dot := X**T * Y ! ! Arguments: -! x - real,dimension(:). The input vector containing the entries of X. -! y - real,dimension(:). The input vector containing the entries of Y. -! desc_a - type(psb_desc_type). The communication descriptor. -! info - integer. Return code +! x(:) - real The input vector containing the entries of X. +! y(:) - real The input vector containing the entries of Y. +! desc_a - type(psb_desc_type). The communication descriptor. +! info - integer. Return code ! function psb_ddotv(x, y,desc_a, info) use psb_descriptor_type @@ -327,18 +328,19 @@ end function psb_ddotv !!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE !!$ POSSIBILITY OF SUCH DAMAGE. !!$ -!!$ +!!$ +! ! Subroutine: psb_ddotvs -! psb_ddot forms the dot product of two distributed vectors, +! psb_ddotvs forms the dot product of two distributed vectors, ! ! dot := X**T * Y ! ! Arguments: -! res - real. The result. -! x - real,dimension(:). The input vector containing the entries of X. -! y - real,dimension(:). The input vector containing the entries of Y. +! res - real The result. +! x(:) - real The input vector containing the entries of X. +! y(:) - real The input vector containing the entries of Y. ! desc_a - type(psb_desc_type). The communication descriptor. -! info - integer. Return code +! info - integer. Return code ! subroutine psb_ddotvs(res, x, y,desc_a, info) use psb_descriptor_type @@ -464,22 +466,19 @@ end subroutine psb_ddotvs !!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE !!$ POSSIBILITY OF SUCH DAMAGE. !!$ -!!$ -! Subroutine: psb_dmdots -! psb_ddot forms the dot product of two distributed vectors, -! -! dot := sub( X )**T * sub( Y ) +!!$ ! -! where sub( X ) denotes X(:,JX) +! Subroutine: psb_dmdots +! psb_dmdots forms the dot product of multiple distributed vectors, ! -! sub( Y ) denotes Y(:,JY). +! res(i) := ( X(:,i) )**T * ( Y(:,i) ) ! ! Arguments: -! res - real. The result. -! x - real,dimension(:,:). The input vector containing the entries of sub( X ). -! y - real,dimension(:,:). The input vector containing the entries of sub( Y ). -! desc_a - type(psb_desc_type). The communication descriptor. -! info - integer. Return code +! res(:) - real. The result. +! x(:,:) - real The input vector containing the entries of ( X ). +! y(:,:) - real The input vector containing the entries of ( Y ). +! desc_a - type(psb_desc_type). The communication descriptor. +! info - integer. Return code ! subroutine psb_dmdots(res, x, y, desc_a, info) use psb_descriptor_type @@ -584,102 +583,3 @@ subroutine psb_dmdots(res, x, y, desc_a, info) return end subroutine psb_dmdots - -subroutine psb_ddot2v(res, x, y,w,z,desc_a, info) - use psb_descriptor_type - use psb_check_mod - use psb_error_mod - use psb_penv_mod - implicit none - - real(kind(1.d0)), intent(in) :: x(:), y(:),w(:), z(:) - real(kind(1.d0)), intent(out) :: res(:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - - ! locals - integer :: ictxt, np, me,& - & err_act, iix, jjx, ix, iy, iiy, jjy, i, m - real(kind(1.D0)) :: dot_local(2) - real(kind(1.d0)) :: ddot - character(len=20) :: name, ch_err - - name='psb_ddot' - if(psb_get_errstatus().ne.0) return - info=0 - call psb_erractionsave(err_act) - - ictxt=psb_cd_get_context(desc_a) - - call psb_info(ictxt, me, np) - if (np == -ione) then - info = 2010 - call psb_errpush(info,name) - goto 9999 - endif - - ix = ione - iy = ione - m = psb_cd_get_global_rows(desc_a) - - ! check vector correctness - call psb_chkvect(m,ione,size(x,1),ix,ix,desc_a,info,iix,jjx) - if (info == 0) & - & call psb_chkvect(m,ione,size(y,1),iy,iy,desc_a,info,iiy,jjy) - if(info.ne.0) then - info=4010 - ch_err='psb_chkvect' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - - if ((iix.ne.ione).or.(iiy.ne.ione)) then - info=3040 - call psb_errpush(info,name) - goto 9999 - end if - - if(m.ne.0) then - if(psb_cd_get_local_rows(desc_a).gt.0) then - dot_local(1) = ddot(psb_cd_get_local_rows(desc_a),& - & x,ione,y,ione) - dot_local(2) = ddot(psb_cd_get_local_rows(desc_a),& - & w,ione,z,ione) - ! adjust dot_local because overlapped elements are computed more than once - i=1 - do while (desc_a%ovrlap_elem(i).ne.-ione) - dot_local(1) = dot_local(1) -& - & (desc_a%ovrlap_elem(i+1)-1)/desc_a%ovrlap_elem(i+1)*& - & x(desc_a%ovrlap_elem(i))*& - & y(desc_a%ovrlap_elem(i)) - dot_local(2) = dot_local(2) -& - & (desc_a%ovrlap_elem(i+1)-1)/desc_a%ovrlap_elem(i+1)*& - & w(desc_a%ovrlap_elem(i))*& - & z(desc_a%ovrlap_elem(i)) - i = i+2 - end do - else - dot_local=0.d0 - end if - else - dot_local=0.d0 - end if - - ! compute global sum - call psb_sum(ictxt, dot_local) - - res(1:2) = dot_local(1:2) - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - - if (err_act.eq.psb_act_abort_) then - call psb_error(ictxt) - return - end if - return -end subroutine psb_ddot2v - diff --git a/base/psblas/psb_dnrm2.f90 b/base/psblas/psb_dnrm2.f90 index a5c420a5..370982ce 100644 --- a/base/psblas/psb_dnrm2.f90 +++ b/base/psblas/psb_dnrm2.f90 @@ -38,10 +38,10 @@ ! where sub( X ) denotes X(:,JX). ! ! Arguments: -! x - real,dimension(:,:). The input vector containing the entries of sub( X ). +! x - real,dimension(:,:). The input vector containing the entries of X. ! desc_a - type(psb_desc_type). The communication descriptor. ! info - integer. Return code -! jx - integer(optional). The column offset for sub( X ). +! jx - integer(optional). The column offset for X . ! function psb_dnrm2(x, desc_a, info, jx) use psb_descriptor_type @@ -170,7 +170,8 @@ end function psb_dnrm2 !!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE !!$ POSSIBILITY OF SUCH DAMAGE. !!$ -!!$ +!!$ +! ! Function: psb_dnrm2 ! Forms the norm2 of a distributed vector, ! @@ -304,11 +305,12 @@ end function psb_dnrm2v !!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE !!$ POSSIBILITY OF SUCH DAMAGE. !!$ -!!$ -! Subroutine: psb_dnrm2 +!!$ +! +! Subroutine: psb_dnrm2vs ! Forms the norm2 of a distributed vector, ! -! norm2 := sqrt ( X**T * X) +! res := sqrt ( X**T * X) ! ! Arguments: ! res - real. The result. diff --git a/base/psblas/psb_dnrmi.f90 b/base/psblas/psb_dnrmi.f90 index 3baccb83..6dc9c0e6 100644 --- a/base/psblas/psb_dnrmi.f90 +++ b/base/psblas/psb_dnrmi.f90 @@ -31,9 +31,9 @@ ! File: psb_dnrmi.f90 ! ! Function: psb_dnrmi -! Forms the approximated norm of a sparse matrix, +! Forms the approximated norm of a sparse matrix, ! -! normi := max(abs(sum(A(i,j)))) +! normi := max(abs(sum(A(i,j)))) ! ! Arguments: ! a - type(psb_dspmat_type). The sparse matrix containing A. diff --git a/base/psblas/psb_dspmm.f90 b/base/psblas/psb_dspmm.f90 index 9b0dede6..98198f68 100644 --- a/base/psblas/psb_dspmm.f90 +++ b/base/psblas/psb_dspmm.f90 @@ -39,43 +39,27 @@ ! ! where: ! -! sub( X ) denotes *if* TRANS = 'N', +! sub( X ) denotes: X(1:N,JX:JX+K-1), ! -! X(1:N,JX:JX+K-1), -! -! *else* -! -! X(1:M,JX:JX+K-1). -! -! *end if* -! -! sub( Y ) denotes *if* trans = 'N', -! -! Y(1:M,JY:JY+K-1), -! -! *else* -! -! Y(1:N,JY:JY+K-1) -! -! *end* *if* +! sub( Y ) denotes: Y(1:M,JY:JY+K-1), ! ! alpha and beta are scalars, and sub( X ) and sub( Y ) are distributed ! vectors and A is a M-by-N distributed matrix. ! ! Arguments: -! alpha - real. The scalar alpha. -! a - type(psb_dspmat_type). The sparse matrix containing A. -! x - real,dimension(:,:). The input vector containing the entries of sub( X ). -! beta - real. The scalar beta. -! y - real,dimension(:,:). The input vector containing the entries of sub( Y ). -! desc_a - type(psb_desc_type). The communication descriptor. -! info - integer. Return code -! trans - character(optional). Whether A or A'. If not present 'N' is assumed. -! k - integer(optional). The number of right-hand sides. -! jx - integer(optional). The column offset for sub( X ). If not present 1 is assumed. -! jy - integer(optional). The column offset for sub( Y ). If not present 1 is assumed. -! work - real,dimension(:)(optional). Working area. -! doswap - integer(optional). Whether to performe halo updates. +! alpha - real The scalar alpha. +! a - type(psb_zspmat_type). The sparse matrix containing A. +! x(:,:) - real The input vector containing the entries of ( X ). +! beta - real The scalar beta. +! y(:,:) - real The input vector containing the entries of ( Y ). +! desc_a - type(psb_desc_type). The communication descriptor. +! info - integer. Return code +! trans - character(optional). Whether A or A'. Default: 'N' +! k - integer(optional). The number of right-hand sides. +! jx - integer(optional). The column offset for ( X ). Default: 1 +! jy - integer(optional). The column offset for ( Y ). Default: 1 +! work(:) - real,(optional). Working area. +! doswap - integer(optional). Whether to performe halo updates. ! subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,& & trans, k, jx, jy, work, doswap) @@ -391,8 +375,9 @@ end subroutine psb_dspmm !!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE !!$ POSSIBILITY OF SUCH DAMAGE. !!$ -!!$ -! Subroutine: psb_dspmmv +!!$ +! +! Subroutine: psb_dspmv ! Performs one of the distributed matrix-vector operations ! ! Y := alpha * Pr * A * Pc * X + beta * Y, or @@ -403,16 +388,16 @@ end subroutine psb_dspmm ! vectors and A is a M-by-N distributed matrix. ! ! Arguments: -! alpha - real. The scalar alpha. -! a - type(psb_dspmat_type). The sparse matrix containing A. -! x - real,dimension(:). The input vector containing the entries of X. -! beta - real. The scalar beta. -! y - real,dimension(:. The input vector containing the entries of Y. -! desc_a - type(psb_desc_type). The communication descriptor. -! info - integer. Return code -! trans - character(optional). Whether A or A'. If not present 'N' is assumed. -! work - real,dimension(:)(optional). Working area. -! doswap - integer(optional). Whether to performe halo updates. +! alpha - real The scalar alpha. +! a - type(psb_zspmat_type). The sparse matrix containing A. +! x(:) - real The input vector containing the entries of ( X ). +! beta - real The scalar beta. +! y(:) - real The input vector containing the entries of ( Y ). +! desc_a - type(psb_desc_type). The communication descriptor. +! info - integer. Return code +! trans - character(optional). Whether A or A'. Default: 'N' +! work(:) - real,(optional). Working area. +! doswap - integer(optional). Whether to performe halo updates. ! subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,& & trans, work, doswap) diff --git a/base/psblas/psb_dspsm.f90 b/base/psblas/psb_dspsm.f90 index 860a569b..672fd1ee 100644 --- a/base/psblas/psb_dspsm.f90 +++ b/base/psblas/psb_dspsm.f90 @@ -55,21 +55,23 @@ ! vector and T is a M-by-M distributed triangular matrix. ! ! Arguments: -! alpha - real. The scalar alpha. -! a - type(psb_dspmat_type). The sparse matrix containing A. -! x - real,dimension(:,:). The input vector containing the entries of sub( X ). -! beta - real. The scalar beta. -! y - real,dimension(:,:). The input vector containing the entries of sub( Y ). -! desc_a - type(psb_desc_type). The communication descriptor. -! info - integer. Return code -! trans - character(optional). Whether A or A'. If not present 'N' is assumed. -! unitd - character(optional). Specify some type of operation with the diagonal matrix D. -! choice - integer(optional). The kind of update to perform on overlap elements. -! d - real,dimension(:)(optional). Matrix for diagonal scaling. -! k - integer(optional). The number of right-hand sides. -! jx - integer(optional). The column offset for sub( X ). If not present 1 is assumed. -! jy - integer(optional). The column offset for sub( Y ). If not present 1 is assumed. -! work - real,dimension(:)(optional). Working area. +! alpha - real The scalar alpha. +! a - type(psb_zspmat_type). The sparse matrix containing A. +! x(:,:) - real The input vector containing the entries of ( X ). +! beta - real The scalar beta. +! y(:,:) - real The input vector containing the entries of ( Y ). +! desc_a - type(psb_desc_type). The communication descriptor. +! info - integer. Return code +! trans - character(optional). Whether A or A'. If not present 'N' is assumed. +! unitd - character(optional). Specify some type of operation with +! the diagonal matrix D. +! choice - integer(optional). The kind of update to perform on overlap elements. +! d(:) - real , optional Matrix for diagonal scaling. +! k - integer(optional). The number of right-hand sides. +! jx - integer(optional). The column offset for ( X ). Default: 1 +! jy - integer(optional). The column offset for ( Y ). Default: 1 +! work(:) - real , optional Working area. +! ! subroutine psb_dspsm(alpha,a,x,beta,y,desc_a,info,& & trans, unitd, choice, diag, k, jx, jy, work) @@ -345,8 +347,9 @@ end subroutine psb_dspsm !!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE !!$ POSSIBILITY OF SUCH DAMAGE. !!$ -!!$ -! Subroutine: psb_dspsmv +!!$ +! +! Subroutine: psb_dspsv ! Performs one of the distributed matrix-vector operations ! ! Y := alpha * Pr * A-1 * Pc * X + beta * Y, or @@ -364,19 +367,21 @@ end subroutine psb_dspsm ! X is a distributed ! vector and T is a M-by-M distributed triangular matrix. ! +! ! Arguments: -! alpha - real. The scalar alpha. -! a - type(psb_dspmat_type). The sparse matrix containing A. -! x - real,dimension(:). The input vector containing the entries of X. -! beta - real. The scalar beta. -! y - real,dimension(:). The input vector containing the entries of Y. -! desc_a - type(psb_desc_type). The communication descriptor. -! info - integer. Return code -! trans - character(optional). Whether A or A'. If not present 'N' is assumed. -! unitd - character(optional). Specify some type of operation with the diagonal matrix D. -! choice - integer(optional). The kind of update to perform on overlap elements. -! d - real,dimension(:)(optional). Matrix for diagonal scaling. -! work - real,dimension(:)(optional). Working area. +! alpha - real The scalar alpha. +! a - type(psb_zspmat_type). The sparse matrix containing A. +! x(:) - real The input vector containing the entries of ( X ). +! beta - real The scalar beta. +! y(:) - real The input vector containing the entries of ( Y ). +! desc_a - type(psb_desc_type). The communication descriptor. +! info - integer. Return code +! trans - character(optional). Whether A or A'. If not present 'N' is assumed. +! unitd - character(optional). Specify some type of operation with +! the diagonal matrix D. +! choice - integer(optional). The kind of update to perform on overlap elements. +! d(:) - real , optional Matrix for diagonal scaling. +! work(:) - real , optional Working area. ! subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,& & trans, unitd, choice, diag, work) diff --git a/base/psblas/psb_zamax.f90 b/base/psblas/psb_zamax.f90 index 16ab18ca..c1fe60dc 100644 --- a/base/psblas/psb_zamax.f90 +++ b/base/psblas/psb_zamax.f90 @@ -38,10 +38,10 @@ ! where sub( X ) denotes X(1:N,JX:). ! ! Arguments: -! x - complex,dimension(:,:). The input vector. -! desc_a - type(psb_desc_type). The communication descriptor. -! info - integer. Return code -! jx - integer(optional). The column offset. +! x(:,:) - complex The input vector. +! desc_a - type(psb_desc_type). The communication descriptor. +! info - integer. Return code +! jx - integer(optional). The column offset. ! function psb_zamax (x,desc_a, info, jx) use psb_penv_mod @@ -161,16 +161,17 @@ end function psb_zamax !!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE !!$ POSSIBILITY OF SUCH DAMAGE. !!$ -!!$ +!!$ +! ! Function: psb_zamaxv ! Searches the absolute max of X. ! ! normi := max(abs(X(i)) ! ! Arguments: -! x - real,dimension(:). The input vector. -! desc_a - type(psb_desc_type). The communication descriptor. -! info - integer. Return code +! x(:) - complex The input vector. +! desc_a - type(psb_desc_type). The communication descriptor. +! info - integer. Return code ! function psb_zamaxv (x,desc_a, info) use psb_penv_mod @@ -180,7 +181,7 @@ function psb_zamaxv (x,desc_a, info) use psb_error_mod implicit none - real(kind(1.d0)), intent(in) :: x(:) + complex(kind(1.d0)), intent(in) :: x(:) type(psb_desc_type), intent(in) :: desc_a integer, intent(out) :: info real(kind(1.d0)) :: psb_zamaxv @@ -294,13 +295,13 @@ end function psb_zamaxv ! where sub( X ) denotes X(1:N,JX:). ! ! Arguments: -! res - real. The result. -! x - real,dimension(:,:). The input vector. -! desc_a - type(psb_desc_type). The communication descriptor. -! info - integer. Return code -! jx - integer(optional). The column offset. +! res - real The result. +! x(:,:) - complex The input vector. +! desc_a - type(psb_desc_type). The communication descriptor. +! info - integer. Return code +! jx - integer(optional). The column offset. ! -subroutine psb_zamaxvs (res,x,desc_a, info) +subroutine psb_zamaxvs(res,x,desc_a, info) use psb_penv_mod use psb_serial_mod use psb_descriptor_type @@ -308,7 +309,7 @@ subroutine psb_zamaxvs (res,x,desc_a, info) use psb_error_mod implicit none - real(kind(1.d0)), intent(in) :: x(:) + complex(kind(1.d0)), intent(in) :: x(:) type(psb_desc_type), intent(in) :: desc_a integer, intent(out) :: info real(kind(1.D0)), intent(out) :: res @@ -420,12 +421,12 @@ end subroutine psb_zamaxvs ! normi := max(abs(X(i)) ! ! Arguments: -! res - real. The result. -! x - real,dimension(:). The input vector. -! desc_a - type(psb_desc_type). The communication descriptor. -! info - integer. Return code +! res(:) - real. The result. +! x(:,:) - complex The input vector. +! desc_a - type(psb_desc_type). The communication descriptor. +! info - integer. Return code ! -subroutine psb_zmamaxs (res,x,desc_a, info,jx) +subroutine psb_zmamaxs(res,x,desc_a, info,jx) use psb_penv_mod use psb_serial_mod use psb_descriptor_type @@ -433,11 +434,11 @@ subroutine psb_zmamaxs (res,x,desc_a, info,jx) use psb_error_mod implicit none - real(kind(1.d0)), intent(in) :: x(:,:) + complex(kind(1.d0)), intent(in) :: x(:,:) type(psb_desc_type), intent(in) :: desc_a integer, intent(out) :: info integer, optional, intent(in) :: jx - real(kind(1.d0)), intent(out) :: res(:) + real(kind(1.d0)), intent(out) :: res(:) ! locals integer :: ictxt, np, me,& diff --git a/base/psblas/psb_zasum.f90 b/base/psblas/psb_zasum.f90 index e453b2c2..094584fd 100644 --- a/base/psblas/psb_zasum.f90 +++ b/base/psblas/psb_zasum.f90 @@ -38,10 +38,10 @@ ! where sub( X ) denotes X(1:N,JX:). ! ! Arguments: -! x - real,dimension(:,:). The input vector. -! desc_a - type(psb_desc_type). The communication descriptor. -! info - integer. Return code -! jx - integer(optional). The column offset. +! x(:,:) - complex The input vector. +! desc_a - type(psb_desc_type). The communication descriptor. +! info - integer. Return code +! jx - integer(optional). The column offset. ! function psb_zasum (x,desc_a, info, jx) @@ -52,7 +52,7 @@ function psb_zasum (x,desc_a, info, jx) use psb_penv_mod implicit none - complex(kind(1.d0)), intent(in) :: x(:,:) + complex(kind(1.d0)), intent(in) :: x(:,:) type(psb_desc_type), intent(in) :: desc_a integer, intent(out) :: info integer, optional, intent(in) :: jx @@ -181,18 +181,19 @@ end function psb_zasum !!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE !!$ POSSIBILITY OF SUCH DAMAGE. !!$ -!!$ +!!$ +! ! Function: psb_zasumv ! Computes norm1 of X ! ! norm1 := sum(X(i)) ! ! Arguments: -! x - real,dimension(:). The input vector. -! desc_a - type(psb_desc_type). The communication descriptor. -! info - integer. Return code +! x(:) - complex The input vector. +! desc_a - type(psb_desc_type). The communication descriptor. +! info - integer. Return code ! -function psb_zasumv (x,desc_a, info) +function psb_zasumv(x,desc_a, info) use psb_serial_mod use psb_descriptor_type @@ -201,7 +202,7 @@ function psb_zasumv (x,desc_a, info) use psb_penv_mod implicit none - complex(kind(1.d0)), intent(in) :: x(:) + complex(kind(1.d0)), intent(in) :: x(:) type(psb_desc_type), intent(in) :: desc_a integer, intent(out) :: info real(kind(1.d0)) :: psb_zasumv @@ -324,20 +325,21 @@ end function psb_zasumv !!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE !!$ POSSIBILITY OF SUCH DAMAGE. !!$ -!!$ -! Subroutine: psb_zasum vs +!!$ +! +! Subroutine: psb_zasumvs ! Computes norm1 of X ! ! norm1 := sum(X(i)) ! ! Arguments: -! res - real. The result. -! x - real,dimension(:). The input vector. -! desc_a - type(psb_desc_type). The communication descriptor. -! info - integer. Return code -! jx - integer(optional). The column offset. +! res - real. The result. +! x(:) - complex The input vector. +! desc_a - type(psb_desc_type). The communication descriptor. +! info - integer. Return code +! jx - integer(optional). The column offset. ! -subroutine psb_zasumvs (res,x,desc_a, info) +subroutine psb_zasumvs(res,x,desc_a, info) use psb_serial_mod use psb_descriptor_type use psb_check_mod @@ -345,7 +347,7 @@ subroutine psb_zasumvs (res,x,desc_a, info) use psb_penv_mod implicit none - complex(kind(1.d0)), intent(in) :: x(:) + complex(kind(1.d0)), intent(in) :: x(:) real(kind(1.d0)), intent(out) :: res type(psb_desc_type), intent(in) :: desc_a integer, intent(out) :: info diff --git a/base/psblas/psb_zaxpby.f90 b/base/psblas/psb_zaxpby.f90 index 81361649..1b6b78dd 100644 --- a/base/psblas/psb_zaxpby.f90 +++ b/base/psblas/psb_zaxpby.f90 @@ -188,7 +188,7 @@ end subroutine psb_zaxpby !!$ !!$ ! -! Subroutine: psb_zgeaxpbyv +! Subroutine: psb_zaxpbyv ! Adds one distributed matrix to another, ! ! Y := beta * Y + alpha * X diff --git a/base/psblas/psb_zdot.f90 b/base/psblas/psb_zdot.f90 index dd161baa..cc8383eb 100644 --- a/base/psblas/psb_zdot.f90 +++ b/base/psblas/psb_zdot.f90 @@ -33,19 +33,19 @@ ! Function: psb_zdot ! psb_zdot forms the dot product of two distributed vectors, ! -! dot := sub( X )**T * sub( Y ) +! dot := sub( X )**C * sub( Y ) ! ! where sub( X ) denotes X(:,JX) ! ! sub( Y ) denotes Y(:,JY). ! ! Arguments: -! x - real,dimension(:,:). The input vector containing the entries of sub( X ). -! y - real,dimension(:,:). The input vector containing the entries of sub( Y ). -! desc_a - type(psb_desc_type). The communication descriptor. -! info - integer. Return code -! jx - integer(optional). The column offset for sub( X ). -! jy - integer(optional). The column offset for sub( Y ). +! x(:,:) - complex The input vector containing the entries of sub( X ). +! y(:,:) - complex The input vector containing the entries of sub( Y ). +! desc_a - type(psb_desc_type). The communication descriptor. +! info - integer. Return code +! jx - integer(optional). The column offset for sub( X ). +! jy - integer(optional). The column offset for sub( Y ). ! function psb_zdot(x, y,desc_a, info, jx, jy) use psb_descriptor_type @@ -189,17 +189,18 @@ end function psb_zdot !!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE !!$ POSSIBILITY OF SUCH DAMAGE. !!$ -!!$ +!!$ +! ! Function: psb_zdotv -! psb_zdot forms the dot product of two distributed vectors, +! psb_zdotv forms the dot product of two distributed vectors, ! -! dot := X**T * Y +! dot := X**C * Y ! ! Arguments: -! x - real,dimension(:). The input vector containing the entries of X. -! y - real,dimension(:). The input vector containing the entries of Y. -! desc_a - type(psb_desc_type). The communication descriptor. -! info - integer. Return code +! x(:) - complex The input vector containing the entries of X. +! y(:) - complex The input vector containing the entries of Y. +! desc_a - type(psb_desc_type). The communication descriptor. +! info - integer. Return code ! function psb_zdotv(x, y,desc_a, info) use psb_descriptor_type @@ -326,18 +327,19 @@ end function psb_zdotv !!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE !!$ POSSIBILITY OF SUCH DAMAGE. !!$ -!!$ +!!$ +! ! Subroutine: psb_zdotvs -! psb_zdot forms the dot product of two distributed vectors, +! psb_zdotvs forms the dot product of two distributed vectors, ! -! dot := X**T * Y +! res := X**C * Y ! ! Arguments: -! res - real. The result. -! x - real,dimension(:). The input vector containing the entries of X. -! y - real,dimension(:). The input vector containing the entries of Y. -! desc_a - type(psb_desc_type). The communication descriptor. -! info - integer. Return code +! res - complex. The result. +! x(:) - complex The input vector containing the entries of X. +! y(:) - complex The input vector containing the entries of Y. +! desc_a - type(psb_desc_type). The communication descriptor. +! info - integer. Return code ! subroutine psb_zdotvs(res, x, y,desc_a, info) use psb_descriptor_type @@ -462,22 +464,19 @@ end subroutine psb_zdotvs !!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE !!$ POSSIBILITY OF SUCH DAMAGE. !!$ -!!$ -! Subroutine: psb_dmdots -! psb_zdot forms the dot product of two distributed vectors, -! -! dot := sub( X )**T * sub( Y ) +!!$ ! -! where sub( X ) denotes X(:,JX) +! Subroutine: psb_zmdots +! psb_zmdots forms the dot product of multiple distributed vectors, ! -! sub( Y ) denotes Y(:,JY). +! res(i) := ( X(:,i) )**C * ( Y(:,i) ) ! ! Arguments: -! res - real. The result. -! x - real,dimension(:,:). The input vector containing the entries of sub( X ). -! y - real,dimension(:,:). The input vector containing the entries of sub( Y ). -! desc_a - type(psb_desc_type). The communication descriptor. -! info - integer. Return code +! res(:) - complex. The result. +! x(:) - complex The input vector containing the entries of sub( X ). +! y(:) - complex The input vector containing the entries of sub( Y ). +! desc_a - type(psb_desc_type). The communication descriptor. +! info - integer. Return code ! subroutine psb_zmdots(res, x, y, desc_a, info) use psb_descriptor_type diff --git a/base/psblas/psb_znrm2.f90 b/base/psblas/psb_znrm2.f90 index c0ec0c03..d15bb43c 100644 --- a/base/psblas/psb_znrm2.f90 +++ b/base/psblas/psb_znrm2.f90 @@ -38,10 +38,10 @@ ! where sub( X ) denotes X(:,JX). ! ! Arguments: -! x - real,dimension(:,:). The input vector containing the entries of sub( X ). -! desc_a - type(psb_desc_type). The communication descriptor. -! info - integer. Return code -! jx - integer(optional). The column offset for sub( X ). +! x(:,:) - complex The input vector containing the entries of sub( X ). +! desc_a - type(psb_desc_type). The communication descriptor. +! info - integer. Return code +! jx - integer(optional). The column offset for sub( X ). ! function psb_znrm2(x, desc_a, info, jx) use psb_descriptor_type @@ -169,16 +169,17 @@ end function psb_znrm2 !!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE !!$ POSSIBILITY OF SUCH DAMAGE. !!$ -!!$ +!!$ +! ! Function: psb_znrm2 ! Forms the norm2 of a distributed vector, ! ! norm2 := sqrt ( X**T * X) ! ! Arguments: -! x - real,dimension(:). The input vector containing the entries of X. -! desc_a - type(psb_desc_type). The communication descriptor. -! info - integer. Return code +! x(:) - complex The input vector containing the entries of X. +! desc_a - type(psb_desc_type). The communication descriptor. +! info - integer. Return code ! function psb_znrm2v(x, desc_a, info) use psb_descriptor_type @@ -303,17 +304,18 @@ end function psb_znrm2v !!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE !!$ POSSIBILITY OF SUCH DAMAGE. !!$ -!!$ -! Subroutine: psb_znrm2 +!!$ +! +! Subroutine: psb_znrm2vs ! Forms the norm2 of a distributed vector, ! ! norm2 := sqrt ( X**T * X) ! ! Arguments: -! res - real. The result. -! x - real,dimension(:). The input vector containing the entries of X. -! desc_a - type(psb_desc_type). The communication descriptor. -! info - integer. Return code +! res - real The result. +! x(:) - complex The input vector containing the entries of X. +! desc_a - type(psb_desc_type). The communication descriptor. +! info - integer. Return code ! subroutine psb_znrm2vs(res, x, desc_a, info) use psb_descriptor_type diff --git a/base/psblas/psb_znrmi.f90 b/base/psblas/psb_znrmi.f90 index 26a95268..9beb0545 100644 --- a/base/psblas/psb_znrmi.f90 +++ b/base/psblas/psb_znrmi.f90 @@ -31,9 +31,9 @@ ! File: psb_znrmi.f90 ! ! Function: psb_znrmi -! Forms the approximated norm of a sparse matrix, +! Forms the approximated norm of a sparse matrix, ! -! normi := max(abs(sum(A(i,j)))) +! normi := max(abs(sum(A(i,j)))) ! ! Arguments: ! a - type(psb_dspmat_type). The sparse matrix containing A. diff --git a/base/psblas/psb_zspmm.f90 b/base/psblas/psb_zspmm.f90 index bd35d059..bf7adb26 100644 --- a/base/psblas/psb_zspmm.f90 +++ b/base/psblas/psb_zspmm.f90 @@ -37,45 +37,29 @@ ! ! sub( Y ) := alpha * Pr * A' * Pr * sub( X ) + beta * sub( Y ), ! -! where: +! ! -! sub( X ) denotes *if* TRANS = 'N', +! sub( X ) denotes: X(1:N,JX:JX+K-1), ! -! X(1:N,JX:JX+K-1), -! -! *else* -! -! X(1:M,JX:JX+K-1). -! -! *end if* -! -! sub( Y ) denotes *if* trans = 'N', -! -! Y(1:M,JY:JY+K-1), -! -! *else* -! -! Y(1:N,JY:JY+K-1) -! -! *end* *if* +! sub( Y ) denotes: Y(1:M,JY:JY+K-1), ! ! alpha and beta are scalars, and sub( X ) and sub( Y ) are distributed ! vectors and A is a M-by-N distributed matrix. ! ! Arguments: -! alpha - real. The scalar alpha. -! a - type(psb_zspmat_type). The sparse matrix containing A. -! x - real,dimension(:,:). The input vector containing the entries of sub( X ). -! beta - real. The scalar beta. -! y - real,dimension(:,:). The input vector containing the entries of sub( Y ). -! desc_a - type(psb_desc_type). The communication descriptor. -! info - integer. Return code -! trans - character(optional). Whether A or A'. If not present 'N' is assumed. -! k - integer(optional). The number of right-hand sides. -! jx - integer(optional). The column offset for sub( X ). If not present 1 is assumed. -! jy - integer(optional). The column offset for sub( Y ). If not present 1 is assumed. -! work - real,dimension(:)(optional). Working area. -! doswap - integer(optional). Whether to performe halo updates. +! alpha - complex The scalar alpha. +! a - type(psb_zspmat_type). The sparse matrix containing A. +! x(:,:) - complex The input vector containing the entries of ( X ). +! beta - complex The scalar beta. +! y(:,:) - complex The input vector containing the entries of ( Y ). +! desc_a - type(psb_desc_type). The communication descriptor. +! info - integer. Return code +! trans - character(optional). Whether A or A'. Default: 'N' +! k - integer(optional). The number of right-hand sides. +! jx - integer(optional). The column offset for ( X ). Default: 1 +! jy - integer(optional). The column offset for ( Y ). Default: 1 +! work(:) - complex,(optional). Working area. +! doswap - integer(optional). Whether to performe halo updates. ! subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,& & trans, k, jx, jy, work, doswap) @@ -156,7 +140,8 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,& endif if (present(trans)) then - if ( (toupper(trans) == 'N').or.(toupper(trans) == 'T').or. (toupper(trans) == 'C')) then + if ( (toupper(trans) == 'N').or.(toupper(trans) == 'T').or.& + & (toupper(trans) == 'C')) then itrans = toupper(trans) else info = 70 @@ -385,8 +370,9 @@ end subroutine psb_zspmm !!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE !!$ POSSIBILITY OF SUCH DAMAGE. !!$ -!!$ -! Subroutine: psb_zspmmv +!!$ +! +! Subroutine: psb_zspmv ! Performs one of the distributed matrix-vector operations ! ! Y := alpha * Pr * A * Pc * X + beta * Y, or @@ -397,16 +383,16 @@ end subroutine psb_zspmm ! vectors and A is a M-by-N distributed matrix. ! ! Arguments: -! alpha - real. The scalar alpha. -! a - type(psb_zspmat_type). The sparse matrix containing A. -! x - real,dimension(:). The input vector containing the entries of X. -! beta - real. The scalar beta. -! y - real,dimension(:. The input vector containing the entries of Y. -! desc_a - type(psb_desc_type). The communication descriptor. -! info - integer. Return code -! trans - character(optional). Whether A or A'. If not present 'N' is assumed. -! work - real,dimension(:)(optional). Working area. -! doswap - integer(optional). Whether to performe halo updates. +! alpha - complex The scalar alpha. +! a - type(psb_zspmat_type). The sparse matrix containing A. +! x(:) - complex The input vector containing the entries of ( X ). +! beta - complex The scalar beta. +! y(:) - complex The input vector containing the entries of ( Y ). +! desc_a - type(psb_desc_type). The communication descriptor. +! info - integer. Return code +! trans - character(optional). Whether A or A'. Default: 'N' +! work(:) - complex,(optional). Working area. +! doswap - integer(optional). Whether to performe halo updates. ! subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,& & trans, work, doswap) @@ -476,7 +462,8 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,& endif if (present(trans)) then - if ( (toupper(trans) == 'N').or.(toupper(trans) == 'T') .or.(toupper(trans) == 'C')) then + if ( (toupper(trans) == 'N').or.(toupper(trans) == 'T') .or.& + & (toupper(trans) == 'C')) then itrans = toupper(trans) else info = 70 diff --git a/base/psblas/psb_zspsm.f90 b/base/psblas/psb_zspsm.f90 index 694e30cf..8cc8f022 100644 --- a/base/psblas/psb_zspsm.f90 +++ b/base/psblas/psb_zspsm.f90 @@ -55,21 +55,22 @@ ! vector and T is a M-by-M distributed triangular matrix. ! ! Arguments: -! alpha - real. The scalar alpha. -! a - type(psb_zspmat_type). The sparse matrix containing A. -! x - real,dimension(:,:). The input vector containing the entries of sub( X ). -! beta - real. The scalar beta. -! y - real,dimension(:,:). The input vector containing the entries of sub( Y ). -! desc_a - type(psb_desc_type). The communication descriptor. -! info - integer. Return code -! trans - character(optional). Whether A or A'. If not present 'N' is assumed. -! unitd - character(optional). Specify some type of operation with the diagonal matrix D. -! choice - integer(optional). The kind of update to perform on overlap elements. -! d - real,dimension(:)(optional). Matrix for diagonal scaling. -! k - integer(optional). The number of right-hand sides. -! jx - integer(optional). The column offset for sub( X ). If not present 1 is assumed. -! jy - integer(optional). The column offset for sub( Y ). If not present 1 is assumed. -! work - real,dimension(:)(optional). Working area. +! alpha - complex. The scalar alpha. +! a - type(psb_zspmat_type). The sparse matrix containing A. +! x(:,:) - complex The input vector containing the entries of ( X ). +! beta - complex The scalar beta. +! y(:,:) - complex The input vector containing the entries of ( Y ). +! desc_a - type(psb_desc_type). The communication descriptor. +! info - integer. Return code +! trans - character(optional). Whether A or A'. If not present 'N' is assumed. +! unitd - character(optional). Specify some type of operation with +! the diagonal matrix D. +! choice - integer(optional). The kind of update to perform on overlap elements. +! d(:) - complex, optional Matrix for diagonal scaling. +! k - integer(optional). The number of right-hand sides. +! jx - integer(optional). The column offset for ( X ). Default: 1 +! jy - integer(optional). The column offset for ( Y ). Default: 1 +! work(:) - complex, optional Working area. ! subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,& & trans, unitd, choice, diag, k, jx, jy, work) @@ -348,8 +349,9 @@ end subroutine psb_zspsm !!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE !!$ POSSIBILITY OF SUCH DAMAGE. !!$ -!!$ -! Subroutine: psb_zspsmv +!!$ +! +! Subroutine: psb_zspsv ! Performs one of the distributed matrix-vector operations ! ! Y := alpha * Pr * A-1 * Pc * X + beta * Y, or @@ -367,19 +369,21 @@ end subroutine psb_zspsm ! X is a distributed ! vector and T is a M-by-M distributed triangular matrix. ! +! ! Arguments: -! alpha - real. The scalar alpha. -! a - type(psb_zspmat_type). The sparse matrix containing A. -! x - real,dimension(:). The input vector containing the entries of X. -! beta - real. The scalar beta. -! y - real,dimension(:). The input vector containing the entries of Y. -! desc_a - type(psb_desc_type). The communication descriptor. -! info - integer. Return code -! trans - character(optional). Whether A or A'. If not present 'N' is assumed. -! unitd - character(optional). Specify some type of operation with the diagonal matrix D. -! choice - integer(optional). The kind of update to perform on overlap elements. -! d - real,dimension(:)(optional). Matrix for diagonal scaling. -! work - real,dimension(:)(optional). Working area. +! alpha - complex. The scalar alpha. +! a - type(psb_zspmat_type). The sparse matrix containing A. +! x(:) - complex The input vector containing the entries of ( X ). +! beta - complex The scalar beta. +! y(:) - complex The input vector containing the entries of ( Y ). +! desc_a - type(psb_desc_type). The communication descriptor. +! info - integer. Return code +! trans - character(optional). Whether A or A'. If not present 'N' is assumed. +! unitd - character(optional). Specify some type of operation with +! the diagonal matrix D. +! choice - integer(optional). The kind of update to perform on overlap elements. +! d(:) - complex, optional Matrix for diagonal scaling. +! work(:) - complex, optional Working area. ! subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,& & trans, unitd, choice, diag, work)