text:
*deck wtint2
      subroutine wtint2( h4,      il,     iprst,  iscm,
     & buffer, values, labels, ibitv )
c
c  assign orbital labels and write records of 2-e integrals.
c
c  01-dec-90 SIFS version. ls(2,*) used as a 2d array. -rls
c
      implicit logical(a-z)
c
      integer    ilfact
      parameter( ilfact=1024 )
c
c     # /bufout/ holds some output integral file parameters.
      integer
     & info,     ifmt1,   ifmt2,   itypea,  itypeb,
     & ibuf,     numout,  nrec,    ntape
      common /bufout/
     & info(10), ifmt1,   ifmt2,   itypea,  itypeb,
     & ibuf,     numout,  nrec,    ntape
c
      integer       l2rec
      equivalence ( l2rec, info(4) )
      integer       n2max
      equivalence ( n2max, info(5) )
c
      integer   nunits
      parameter(nunits=4)
      integer        iunits
      common /units/ iunits(nunits)
      integer                  nlist
      equivalence ( iunits(1), nlist )
c
      real*8         cutoff, tol
      common /parmr/ cutoff, tol
c
      integer
     & mblu,  mccu, mconu, mcu,  mcxu, mpru, nbft, nnbft,
     & mrcru, mstu, msu,   nblu, ng,   ns,   nst
      common /parmi/
     & mblu,  mccu, mconu, mcu,  mcxu, mpru, nbft, nnbft,
     & mrcru, mstu, msu,   nblu, ng,   ns,   nst
c
      logical       eprsf,    esfi,    esfk
      common /lgcl/ eprsf(3), esfi(3), esfk(3)
c
      integer
     & itl,    itu,    jtl,    jtu,    ktl,    ktu,    ltl,    ltu,
     & jcu,    kcu,    lcu,    inx,    jnx,    knx,    lnx,    nwt,
     & nwt1,           ijsf,           klsf,           icxs,
     & kcxs,           npri,           nprk,           iesfbx, kesfbx,
     & ircrux, jrcrux, krcrux, lrcrux
      common /ntgr/
     & itl,    itu,    jtl,    jtu,    ktl,    ktu,    ltl,    ltu,
     & jcu,    kcu,    lcu,    inx,    jnx,    knx,    lnx,    nwt,
     & nwt1(3),        ijsf(3),        klsf(3),        icxs(2,3),
     & kcxs(2,3),      npri(2,3),      nprk(2,3),      iesfbx, kesfbx,
     & ircrux, jrcrux, krcrux, lrcrux
c
      integer       npriri,        nprirk
      common /ikpr/ npriri(2,3,8), nprirk(2,3,8)
c
      real*8
     & xij,    xijm,   yij,    yijm,   zij,    zijm,   xkl,    xklm,
     & ykl,    yklm,   zkl,    zklm
      integer
     & icons,  ircru,  jcons,  jrcru,  kcons,  krcru,  lcons,  lrcru
      logical
     & esfc,   esfcij, esfckl
      common /misc/
     & xij,    xijm,   yij,    yijm,   zij,    zijm,   xkl,    xklm,
     & ykl,    yklm,   zkl,    zklm,
     & icons,  ircru,  jcons,  jrcru,  kcons,  krcru,  lcons,  lrcru,
     & esfc,   esfcij, esfckl
c
      integer    nipv
      parameter( nipv=4 )
c
c     # dummy:
      integer iscm
      integer il(*), iprst(*), labels(nipv,*), ibitv(*)
      real*8 h4(*), buffer(*), values(*)
c     # ibm+convex f77 bug; actual:
c     # integer labels(nipv,n2max), ibitv( ((n2max+63)/64)*64 )
c     # real*8 buffer(l2rec), values(n2max)
c
c     # local:
      integer ibl, ipr, kprib, ircr, jrcr, iesfb, iprkb, kpr, krcr,
     & lrcr, kesfb, ist, npairi, npairk, kpri, ipair, kpair
      integer    msame
      parameter( msame=0 )
c
      ibl = 0
      ipr = iprst(ijsf(iscm))
      if ( eprsf(iscm) ) then
        kprib = ipr
      else
        kprib = iprst(klsf(iscm))
      endif
      do 176 ircr = 1, ircru
        if ( esfi(iscm) ) jrcru = ircr
        do 174 jrcr = 1, jrcru
          if ( esfi(iscm) .and. (ircr .eq. jrcr) ) then
            iesfb = 1
          else
            iesfb = 2
          endif
          iprkb = ipr
          kpr = kprib
          if ( eprsf(iscm) ) krcru = ircr
          do 172 krcr = 1, krcru
            if ( eprsf(iscm) ) then
              if ( ircr .eq. krcr ) then
                lrcru = jrcr
              elseif ( esfk(iscm) ) then
                lrcru = krcr
              else
                lrcru = jrcru
              endif
            else
              if ( esfk(iscm) ) lrcru = krcr
            endif
            do 170 lrcr = 1,lrcru
              if ( esfk(iscm) .and. (krcr .eq. lrcr) ) then
                kesfb = 1
              else
                kesfb = 2
              endif
              ipr = iprkb
              do 160 ist = 1, nst
                npairi = npriri(iesfb,iscm,ist)
                npairk = nprirk(kesfb,iscm,ist)
                if ( npairi .eq. 0 ) then
                  kpr = kpr + npairk
                  go to 160
                elseif ( npairk .eq. 0 ) then
                  ipr = ipr + npairi
                  go to 160
                endif
                kpri = kpr
                do 150 ipair = 1, npairi
                  ipr = ipr + 1
                  if ( eprsf(iscm) .and. (ircr .eq. krcr)
     &             .and. (jrcr .eq. lrcr) ) npairk = ipair
                  kpr = kpri
                  do 140 kpair = 1, npairk
                    kpr = kpr + 1
                    ibl = ibl + 1
                    if ( abs(h4(ibl)) .gt. cutoff ) then
                      if ( ibuf .eq. n2max ) then
                        call wtlab2( msame, buffer, values, labels,
     &                   ibitv )
                      endif
                      ibuf           = ibuf + 1
                      labels(1,ibuf) = il(ipr) / ilfact
                      labels(2,ibuf) = mod( il(ipr), ilfact )
                      labels(3,ibuf) = il(kpr) / ilfact
                      labels(4,ibuf) = mod( il(kpr), ilfact )
                      values(ibuf)   = h4(ibl)
                    endif
140               continue
150             continue
160           continue
170         continue
172       continue
174     continue
176   continue
c
      return
      end

ext: f

max_stars_repo_name: MOLFDIR/MOLFDIR

max_issues_repo_name: yingxingcheng/MOLFDIR

max_forks_repo_name: yingxingcheng/MOLFDIR


module psb_d_mvsv_tester
contains

  subroutine d_usmv_2_n_ap3_bp1_ix1_iy1(res,afmt,ctxt)
    use psb_base_mod
    implicit none
    character(len=*) :: afmt
    type(psb_dspmat_type) :: a
    type(psb_desc_type)   :: desc_a
    type(psb_ctxt_type) :: ctxt
    integer(psb_ipk_) :: iam=-1, np=-1
    integer(psb_ipk_) :: info=-1

    integer(psb_ipk_) ::res,istat=0,i
    character::transa='n'
    integer(psb_ipk_) :: incx=1
    integer(psb_ipk_) :: incy=1
    real*8 :: alpha=3
    real*8 :: beta=1
    ! 1 1
    ! 0 0

    ! declaration of VA,IA,JA
    integer(psb_ipk_) :: nnz=2
    integer(psb_ipk_) :: m=2
    integer(psb_ipk_) :: k=2
    integer(psb_ipk_) :: IA(2)=(/1, 1/)
    integer(psb_ipk_) :: JA(2)=(/1, 2/)
    real*8 :: VA(2)=(/1, 1/)
    real*8 :: x(2)=(/1, 1/)! reference x
    real*8 :: cy(2)=(/9, 3/)! reference cy after
    real*8 :: bcy(2)=(/3, 3/)! reference bcy before
    real*8 :: y(2)=(/3, 3/)! y

    y=bcy
    res=0
    call psb_info(ctxt,iam,np)
    if(iam<0)then
      info=-1
      goto 9999
    endif
    call psb_barrier(ctxt)
    call psb_cdall(ctxt,desc_a,info,nl=m)
    if (info /= psb_success_)goto 9996
    call psb_spall(a,desc_a,info,nnz=nnz)
    if (info /= psb_success_)goto 9996
    call psb_barrier(ctxt)
    call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_cdasb(desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
    if(info.ne.0)print *,"matrix assembly failed"
    if(info.ne.0)goto 9996

    call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
    if(info.ne.0)print *,"psb_spmm failed"
    if(info.ne.0)goto 9996
    do i=1,2
      if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
      if(y(i) /= cy(i))info=-1
      if(y(i) /= cy(i))goto 9996
    enddo
9996 continue
    if(info /= psb_success_)res=res+1
    call psb_spfree(a,desc_a,info)
    if (info /= psb_success_)goto 9997
9997 continue
    if(info /= psb_success_)res=res+1
    call psb_cdfree(desc_a,info)
    if (info /= psb_success_)goto 9998
9998 continue
    if(info /= psb_success_)res=res+1
9999 continue
    if(info /= psb_success_)res=res+1
    if(res /= 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha= 3 beta= 1 incx=1 incy=1 trans=n is not ok"
    if(res == 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha= 3 beta= 1 incx=1 incy=1 trans=n is ok"
  end subroutine d_usmv_2_n_ap3_bp1_ix1_iy1
  !

  subroutine d_usmv_2_t_ap3_bp1_ix1_iy1(res,afmt,ctxt)
    use psb_base_mod
    implicit none
    character(len=*) :: afmt
    type(psb_dspmat_type) :: a
    type(psb_desc_type)   :: desc_a
    type(psb_ctxt_type) :: ctxt
    integer(psb_ipk_) :: iam=-1, np=-1
    integer(psb_ipk_) :: info=-1

    integer(psb_ipk_) ::res,istat=0,i
    character::transa='t'
    integer(psb_ipk_) :: incx=1
    integer(psb_ipk_) :: incy=1
    real*8 :: alpha=3
    real*8 :: beta=1
    ! 1 0
    ! 0 1

    ! declaration of VA,IA,JA
    integer(psb_ipk_) :: nnz=2
    integer(psb_ipk_) :: m=2
    integer(psb_ipk_) :: k=2
    integer(psb_ipk_) :: IA(2)=(/1, 2/)
    integer(psb_ipk_) :: JA(2)=(/1, 2/)
    real*8 :: VA(2)=(/1, 1/)
    real*8 :: x(2)=(/1, 1/)! reference x
    real*8 :: cy(2)=(/6, 6/)! reference cy after
    real*8 :: bcy(2)=(/3, 3/)! reference bcy before
    real*8 :: y(2)=(/3, 3/)! y

    y=bcy
    res=0
    call psb_info(ctxt,iam,np)
    if(iam<0)then
      info=-1
      goto 9999
    endif
    call psb_barrier(ctxt)
    call psb_cdall(ctxt,desc_a,info,nl=m)
    if (info /= psb_success_)goto 9996
    call psb_spall(a,desc_a,info,nnz=nnz)
    if (info /= psb_success_)goto 9996
    call psb_barrier(ctxt)
    call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_cdasb(desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
    if(info.ne.0)print *,"matrix assembly failed"
    if(info.ne.0)goto 9996

    call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
    if(info.ne.0)print *,"psb_spmm failed"
    if(info.ne.0)goto 9996
    do i=1,2
      if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
      if(y(i) /= cy(i))info=-1
      if(y(i) /= cy(i))goto 9996
    enddo
9996 continue
    if(info /= psb_success_)res=res+1
    call psb_spfree(a,desc_a,info)
    if (info /= psb_success_)goto 9997
9997 continue
    if(info /= psb_success_)res=res+1
    call psb_cdfree(desc_a,info)
    if (info /= psb_success_)goto 9998
9998 continue
    if(info /= psb_success_)res=res+1
9999 continue
    if(info /= psb_success_)res=res+1
    if(res /= 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha= 3 beta= 1 incx=1 incy=1 trans=t is not ok"
    if(res == 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha= 3 beta= 1 incx=1 incy=1 trans=t is ok"
  end subroutine d_usmv_2_t_ap3_bp1_ix1_iy1
  !

  subroutine d_usmv_2_c_ap3_bp1_ix1_iy1(res,afmt,ctxt)
    use psb_base_mod
    implicit none
    character(len=*) :: afmt
    type(psb_dspmat_type) :: a
    type(psb_desc_type)   :: desc_a
    type(psb_ctxt_type) :: ctxt
    integer(psb_ipk_) :: iam=-1, np=-1
    integer(psb_ipk_) :: info=-1

    integer(psb_ipk_) ::res,istat=0,i
    character::transa='c'
    integer(psb_ipk_) :: incx=1
    integer(psb_ipk_) :: incy=1
    real*8 :: alpha=3
    real*8 :: beta=1
    ! 1 0
    ! 3 1

    ! declaration of VA,IA,JA
    integer(psb_ipk_) :: nnz=3
    integer(psb_ipk_) :: m=2
    integer(psb_ipk_) :: k=2
    integer(psb_ipk_) :: IA(3)=(/1, 2, 2/)
    integer(psb_ipk_) :: JA(3)=(/1, 1, 2/)
    real*8 :: VA(3)=(/1, 3, 1/)
    real*8 :: x(2)=(/1, 1/)! reference x
    real*8 :: cy(2)=(/15, 6/)! reference cy after
    real*8 :: bcy(2)=(/3, 3/)! reference bcy before
    real*8 :: y(2)=(/3, 3/)! y

    y=bcy
    res=0
    call psb_info(ctxt,iam,np)
    if(iam<0)then
      info=-1
      goto 9999
    endif
    call psb_barrier(ctxt)
    call psb_cdall(ctxt,desc_a,info,nl=m)
    if (info /= psb_success_)goto 9996
    call psb_spall(a,desc_a,info,nnz=nnz)
    if (info /= psb_success_)goto 9996
    call psb_barrier(ctxt)
    call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_cdasb(desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
    if(info.ne.0)print *,"matrix assembly failed"
    if(info.ne.0)goto 9996

    call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
    if(info.ne.0)print *,"psb_spmm failed"
    if(info.ne.0)goto 9996
    do i=1,2
      if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
      if(y(i) /= cy(i))info=-1
      if(y(i) /= cy(i))goto 9996
    enddo
9996 continue
    if(info /= psb_success_)res=res+1
    call psb_spfree(a,desc_a,info)
    if (info /= psb_success_)goto 9997
9997 continue
    if(info /= psb_success_)res=res+1
    call psb_cdfree(desc_a,info)
    if (info /= psb_success_)goto 9998
9998 continue
    if(info /= psb_success_)res=res+1
9999 continue
    if(info /= psb_success_)res=res+1
    if(res /= 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha= 3 beta= 1 incx=1 incy=1 trans=c is not ok"
    if(res == 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha= 3 beta= 1 incx=1 incy=1 trans=c is ok"
  end subroutine d_usmv_2_c_ap3_bp1_ix1_iy1
  !

  subroutine d_usmv_2_n_ap3_bm0_ix1_iy1(res,afmt,ctxt)
    use psb_base_mod
    implicit none
    character(len=*) :: afmt
    type(psb_dspmat_type) :: a
    type(psb_desc_type)   :: desc_a
    type(psb_ctxt_type) :: ctxt
    integer(psb_ipk_) :: iam=-1, np=-1
    integer(psb_ipk_) :: info=-1

    integer(psb_ipk_) ::res,istat=0,i
    character::transa='n'
    integer(psb_ipk_) :: incx=1
    integer(psb_ipk_) :: incy=1
    real*8 :: alpha=3
    real*8 :: beta=0
    ! 1 3
    ! 3 0

    ! declaration of VA,IA,JA
    integer(psb_ipk_) :: nnz=3
    integer(psb_ipk_) :: m=2
    integer(psb_ipk_) :: k=2
    integer(psb_ipk_) :: IA(3)=(/1, 1, 2/)
    integer(psb_ipk_) :: JA(3)=(/1, 2, 1/)
    real*8 :: VA(3)=(/1, 3, 3/)
    real*8 :: x(2)=(/1, 1/)! reference x
    real*8 :: cy(2)=(/12, 9/)! reference cy after
    real*8 :: bcy(2)=(/3, 3/)! reference bcy before
    real*8 :: y(2)=(/3, 3/)! y

    y=bcy
    res=0
    call psb_info(ctxt,iam,np)
    if(iam<0)then
      info=-1
      goto 9999
    endif
    call psb_barrier(ctxt)
    call psb_cdall(ctxt,desc_a,info,nl=m)
    if (info /= psb_success_)goto 9996
    call psb_spall(a,desc_a,info,nnz=nnz)
    if (info /= psb_success_)goto 9996
    call psb_barrier(ctxt)
    call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_cdasb(desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
    if(info.ne.0)print *,"matrix assembly failed"
    if(info.ne.0)goto 9996

    call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
    if(info.ne.0)print *,"psb_spmm failed"
    if(info.ne.0)goto 9996
    do i=1,2
      if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
      if(y(i) /= cy(i))info=-1
      if(y(i) /= cy(i))goto 9996
    enddo
9996 continue
    if(info /= psb_success_)res=res+1
    call psb_spfree(a,desc_a,info)
    if (info /= psb_success_)goto 9997
9997 continue
    if(info /= psb_success_)res=res+1
    call psb_cdfree(desc_a,info)
    if (info /= psb_success_)goto 9998
9998 continue
    if(info /= psb_success_)res=res+1
9999 continue
    if(info /= psb_success_)res=res+1
    if(res /= 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha= 3 beta= 0 incx=1 incy=1 trans=n is not ok"
    if(res == 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha= 3 beta= 0 incx=1 incy=1 trans=n is ok"
  end subroutine d_usmv_2_n_ap3_bm0_ix1_iy1
  !

  subroutine d_usmv_2_t_ap3_bm0_ix1_iy1(res,afmt,ctxt)
    use psb_base_mod
    implicit none
    character(len=*) :: afmt
    type(psb_dspmat_type) :: a
    type(psb_desc_type)   :: desc_a
    type(psb_ctxt_type) :: ctxt
    integer(psb_ipk_) :: iam=-1, np=-1
    integer(psb_ipk_) :: info=-1

    integer(psb_ipk_) ::res,istat=0,i
    character::transa='t'
    integer(psb_ipk_) :: incx=1
    integer(psb_ipk_) :: incy=1
    real*8 :: alpha=3
    real*8 :: beta=0
    ! 1 3
    ! 3 0

    ! declaration of VA,IA,JA
    integer(psb_ipk_) :: nnz=3
    integer(psb_ipk_) :: m=2
    integer(psb_ipk_) :: k=2
    integer(psb_ipk_) :: IA(3)=(/1, 1, 2/)
    integer(psb_ipk_) :: JA(3)=(/1, 2, 1/)
    real*8 :: VA(3)=(/1, 3, 3/)
    real*8 :: x(2)=(/1, 1/)! reference x
    real*8 :: cy(2)=(/12, 9/)! reference cy after
    real*8 :: bcy(2)=(/3, 3/)! reference bcy before
    real*8 :: y(2)=(/3, 3/)! y

    y=bcy
    res=0
    call psb_info(ctxt,iam,np)
    if(iam<0)then
      info=-1
      goto 9999
    endif
    call psb_barrier(ctxt)
    call psb_cdall(ctxt,desc_a,info,nl=m)
    if (info /= psb_success_)goto 9996
    call psb_spall(a,desc_a,info,nnz=nnz)
    if (info /= psb_success_)goto 9996
    call psb_barrier(ctxt)
    call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_cdasb(desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
    if(info.ne.0)print *,"matrix assembly failed"
    if(info.ne.0)goto 9996

    call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
    if(info.ne.0)print *,"psb_spmm failed"
    if(info.ne.0)goto 9996
    do i=1,2
      if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
      if(y(i) /= cy(i))info=-1
      if(y(i) /= cy(i))goto 9996
    enddo
9996 continue
    if(info /= psb_success_)res=res+1
    call psb_spfree(a,desc_a,info)
    if (info /= psb_success_)goto 9997
9997 continue
    if(info /= psb_success_)res=res+1
    call psb_cdfree(desc_a,info)
    if (info /= psb_success_)goto 9998
9998 continue
    if(info /= psb_success_)res=res+1
9999 continue
    if(info /= psb_success_)res=res+1
    if(res /= 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha= 3 beta= 0 incx=1 incy=1 trans=t is not ok"
    if(res == 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha= 3 beta= 0 incx=1 incy=1 trans=t is ok"
  end subroutine d_usmv_2_t_ap3_bm0_ix1_iy1
  !

  subroutine d_usmv_2_c_ap3_bm0_ix1_iy1(res,afmt,ctxt)
    use psb_base_mod
    implicit none
    character(len=*) :: afmt
    type(psb_dspmat_type) :: a
    type(psb_desc_type)   :: desc_a
    type(psb_ctxt_type) :: ctxt
    integer(psb_ipk_) :: iam=-1, np=-1
    integer(psb_ipk_) :: info=-1

    integer(psb_ipk_) ::res,istat=0,i
    character::transa='c'
    integer(psb_ipk_) :: incx=1
    integer(psb_ipk_) :: incy=1
    real*8 :: alpha=3
    real*8 :: beta=0
    ! 1 0
    ! 0 0

    ! declaration of VA,IA,JA
    integer(psb_ipk_) :: nnz=1
    integer(psb_ipk_) :: m=2
    integer(psb_ipk_) :: k=2
    integer(psb_ipk_) :: IA(1)=(/1/)
    integer(psb_ipk_) :: JA(1)=(/1/)
    real*8 :: VA(1)=(/1/)
    real*8 :: x(2)=(/1, 1/)! reference x
    real*8 :: cy(2)=(/3, 0/)! reference cy after
    real*8 :: bcy(2)=(/3, 3/)! reference bcy before
    real*8 :: y(2)=(/3, 3/)! y

    y=bcy
    res=0
    call psb_info(ctxt,iam,np)
    if(iam<0)then
      info=-1
      goto 9999
    endif
    call psb_barrier(ctxt)
    call psb_cdall(ctxt,desc_a,info,nl=m)
    if (info /= psb_success_)goto 9996
    call psb_spall(a,desc_a,info,nnz=nnz)
    if (info /= psb_success_)goto 9996
    call psb_barrier(ctxt)
    call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_cdasb(desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
    if(info.ne.0)print *,"matrix assembly failed"
    if(info.ne.0)goto 9996

    call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
    if(info.ne.0)print *,"psb_spmm failed"
    if(info.ne.0)goto 9996
    do i=1,2
      if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
      if(y(i) /= cy(i))info=-1
      if(y(i) /= cy(i))goto 9996
    enddo
9996 continue
    if(info /= psb_success_)res=res+1
    call psb_spfree(a,desc_a,info)
    if (info /= psb_success_)goto 9997
9997 continue
    if(info /= psb_success_)res=res+1
    call psb_cdfree(desc_a,info)
    if (info /= psb_success_)goto 9998
9998 continue
    if(info /= psb_success_)res=res+1
9999 continue
    if(info /= psb_success_)res=res+1
    if(res /= 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha= 3 beta= 0 incx=1 incy=1 trans=c is not ok"
    if(res == 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha= 3 beta= 0 incx=1 incy=1 trans=c is ok"
  end subroutine d_usmv_2_c_ap3_bm0_ix1_iy1
  !

  subroutine d_usmv_2_n_ap1_bp1_ix1_iy1(res,afmt,ctxt)
    use psb_base_mod
    implicit none
    character(len=*) :: afmt
    type(psb_dspmat_type) :: a
    type(psb_desc_type)   :: desc_a
    type(psb_ctxt_type) :: ctxt
    integer(psb_ipk_) :: iam=-1, np=-1
    integer(psb_ipk_) :: info=-1

    integer(psb_ipk_) ::res,istat=0,i
    character::transa='n'
    integer(psb_ipk_) :: incx=1
    integer(psb_ipk_) :: incy=1
    real*8 :: alpha=1
    real*8 :: beta=1
    ! 1 0
    ! 0 2

    ! declaration of VA,IA,JA
    integer(psb_ipk_) :: nnz=2
    integer(psb_ipk_) :: m=2
    integer(psb_ipk_) :: k=2
    integer(psb_ipk_) :: IA(2)=(/1, 2/)
    integer(psb_ipk_) :: JA(2)=(/1, 2/)
    real*8 :: VA(2)=(/1, 2/)
    real*8 :: x(2)=(/1, 1/)! reference x
    real*8 :: cy(2)=(/4, 5/)! reference cy after
    real*8 :: bcy(2)=(/3, 3/)! reference bcy before
    real*8 :: y(2)=(/3, 3/)! y

    y=bcy
    res=0
    call psb_info(ctxt,iam,np)
    if(iam<0)then
      info=-1
      goto 9999
    endif
    call psb_barrier(ctxt)
    call psb_cdall(ctxt,desc_a,info,nl=m)
    if (info /= psb_success_)goto 9996
    call psb_spall(a,desc_a,info,nnz=nnz)
    if (info /= psb_success_)goto 9996
    call psb_barrier(ctxt)
    call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_cdasb(desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
    if(info.ne.0)print *,"matrix assembly failed"
    if(info.ne.0)goto 9996

    call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
    if(info.ne.0)print *,"psb_spmm failed"
    if(info.ne.0)goto 9996
    do i=1,2
      if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
      if(y(i) /= cy(i))info=-1
      if(y(i) /= cy(i))goto 9996
    enddo
9996 continue
    if(info /= psb_success_)res=res+1
    call psb_spfree(a,desc_a,info)
    if (info /= psb_success_)goto 9997
9997 continue
    if(info /= psb_success_)res=res+1
    call psb_cdfree(desc_a,info)
    if (info /= psb_success_)goto 9998
9998 continue
    if(info /= psb_success_)res=res+1
9999 continue
    if(info /= psb_success_)res=res+1
    if(res /= 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha= 1 beta= 1 incx=1 incy=1 trans=n is not ok"
    if(res == 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha= 1 beta= 1 incx=1 incy=1 trans=n is ok"
  end subroutine d_usmv_2_n_ap1_bp1_ix1_iy1
  !

  subroutine d_usmv_2_t_ap1_bp1_ix1_iy1(res,afmt,ctxt)
    use psb_base_mod
    implicit none
    character(len=*) :: afmt
    type(psb_dspmat_type) :: a
    type(psb_desc_type)   :: desc_a
    type(psb_ctxt_type) :: ctxt
    integer(psb_ipk_) :: iam=-1, np=-1
    integer(psb_ipk_) :: info=-1

    integer(psb_ipk_) ::res,istat=0,i
    character::transa='t'
    integer(psb_ipk_) :: incx=1
    integer(psb_ipk_) :: incy=1
    real*8 :: alpha=1
    real*8 :: beta=1
    ! 1 0
    ! 1 0

    ! declaration of VA,IA,JA
    integer(psb_ipk_) :: nnz=2
    integer(psb_ipk_) :: m=2
    integer(psb_ipk_) :: k=2
    integer(psb_ipk_) :: IA(2)=(/1, 2/)
    integer(psb_ipk_) :: JA(2)=(/1, 1/)
    real*8 :: VA(2)=(/1, 1/)
    real*8 :: x(2)=(/1, 1/)! reference x
    real*8 :: cy(2)=(/5, 3/)! reference cy after
    real*8 :: bcy(2)=(/3, 3/)! reference bcy before
    real*8 :: y(2)=(/3, 3/)! y

    y=bcy
    res=0
    call psb_info(ctxt,iam,np)
    if(iam<0)then
      info=-1
      goto 9999
    endif
    call psb_barrier(ctxt)
    call psb_cdall(ctxt,desc_a,info,nl=m)
    if (info /= psb_success_)goto 9996
    call psb_spall(a,desc_a,info,nnz=nnz)
    if (info /= psb_success_)goto 9996
    call psb_barrier(ctxt)
    call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_cdasb(desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
    if(info.ne.0)print *,"matrix assembly failed"
    if(info.ne.0)goto 9996

    call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
    if(info.ne.0)print *,"psb_spmm failed"
    if(info.ne.0)goto 9996
    do i=1,2
      if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
      if(y(i) /= cy(i))info=-1
      if(y(i) /= cy(i))goto 9996
    enddo
9996 continue
    if(info /= psb_success_)res=res+1
    call psb_spfree(a,desc_a,info)
    if (info /= psb_success_)goto 9997
9997 continue
    if(info /= psb_success_)res=res+1
    call psb_cdfree(desc_a,info)
    if (info /= psb_success_)goto 9998
9998 continue
    if(info /= psb_success_)res=res+1
9999 continue
    if(info /= psb_success_)res=res+1
    if(res /= 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha= 1 beta= 1 incx=1 incy=1 trans=t is not ok"
    if(res == 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha= 1 beta= 1 incx=1 incy=1 trans=t is ok"
  end subroutine d_usmv_2_t_ap1_bp1_ix1_iy1
  !

  subroutine d_usmv_2_c_ap1_bp1_ix1_iy1(res,afmt,ctxt)
    use psb_base_mod
    implicit none
    character(len=*) :: afmt
    type(psb_dspmat_type) :: a
    type(psb_desc_type)   :: desc_a
    type(psb_ctxt_type) :: ctxt
    integer(psb_ipk_) :: iam=-1, np=-1
    integer(psb_ipk_) :: info=-1

    integer(psb_ipk_) ::res,istat=0,i
    character::transa='c'
    integer(psb_ipk_) :: incx=1
    integer(psb_ipk_) :: incy=1
    real*8 :: alpha=1
    real*8 :: beta=1
    ! 1 0
    ! 0 0

    ! declaration of VA,IA,JA
    integer(psb_ipk_) :: nnz=1
    integer(psb_ipk_) :: m=2
    integer(psb_ipk_) :: k=2
    integer(psb_ipk_) :: IA(1)=(/1/)
    integer(psb_ipk_) :: JA(1)=(/1/)
    real*8 :: VA(1)=(/1/)
    real*8 :: x(2)=(/1, 1/)! reference x
    real*8 :: cy(2)=(/4, 3/)! reference cy after
    real*8 :: bcy(2)=(/3, 3/)! reference bcy before
    real*8 :: y(2)=(/3, 3/)! y

    y=bcy
    res=0
    call psb_info(ctxt,iam,np)
    if(iam<0)then
      info=-1
      goto 9999
    endif
    call psb_barrier(ctxt)
    call psb_cdall(ctxt,desc_a,info,nl=m)
    if (info /= psb_success_)goto 9996
    call psb_spall(a,desc_a,info,nnz=nnz)
    if (info /= psb_success_)goto 9996
    call psb_barrier(ctxt)
    call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_cdasb(desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
    if(info.ne.0)print *,"matrix assembly failed"
    if(info.ne.0)goto 9996

    call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
    if(info.ne.0)print *,"psb_spmm failed"
    if(info.ne.0)goto 9996
    do i=1,2
      if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
      if(y(i) /= cy(i))info=-1
      if(y(i) /= cy(i))goto 9996
    enddo
9996 continue
    if(info /= psb_success_)res=res+1
    call psb_spfree(a,desc_a,info)
    if (info /= psb_success_)goto 9997
9997 continue
    if(info /= psb_success_)res=res+1
    call psb_cdfree(desc_a,info)
    if (info /= psb_success_)goto 9998
9998 continue
    if(info /= psb_success_)res=res+1
9999 continue
    if(info /= psb_success_)res=res+1
    if(res /= 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha= 1 beta= 1 incx=1 incy=1 trans=c is not ok"
    if(res == 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha= 1 beta= 1 incx=1 incy=1 trans=c is ok"
  end subroutine d_usmv_2_c_ap1_bp1_ix1_iy1
  !

  subroutine d_usmv_2_n_ap1_bm0_ix1_iy1(res,afmt,ctxt)
    use psb_base_mod
    implicit none
    character(len=*) :: afmt
    type(psb_dspmat_type) :: a
    type(psb_desc_type)   :: desc_a
    type(psb_ctxt_type) :: ctxt
    integer(psb_ipk_) :: iam=-1, np=-1
    integer(psb_ipk_) :: info=-1

    integer(psb_ipk_) ::res,istat=0,i
    character::transa='n'
    integer(psb_ipk_) :: incx=1
    integer(psb_ipk_) :: incy=1
    real*8 :: alpha=1
    real*8 :: beta=0
    ! 1 0
    ! 3 4

    ! declaration of VA,IA,JA
    integer(psb_ipk_) :: nnz=3
    integer(psb_ipk_) :: m=2
    integer(psb_ipk_) :: k=2
    integer(psb_ipk_) :: IA(3)=(/1, 2, 2/)
    integer(psb_ipk_) :: JA(3)=(/1, 1, 2/)
    real*8 :: VA(3)=(/1, 3, 4/)
    real*8 :: x(2)=(/1, 1/)! reference x
    real*8 :: cy(2)=(/1, 7/)! reference cy after
    real*8 :: bcy(2)=(/3, 3/)! reference bcy before
    real*8 :: y(2)=(/3, 3/)! y

    y=bcy
    res=0
    call psb_info(ctxt,iam,np)
    if(iam<0)then
      info=-1
      goto 9999
    endif
    call psb_barrier(ctxt)
    call psb_cdall(ctxt,desc_a,info,nl=m)
    if (info /= psb_success_)goto 9996
    call psb_spall(a,desc_a,info,nnz=nnz)
    if (info /= psb_success_)goto 9996
    call psb_barrier(ctxt)
    call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_cdasb(desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
    if(info.ne.0)print *,"matrix assembly failed"
    if(info.ne.0)goto 9996

    call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
    if(info.ne.0)print *,"psb_spmm failed"
    if(info.ne.0)goto 9996
    do i=1,2
      if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
      if(y(i) /= cy(i))info=-1
      if(y(i) /= cy(i))goto 9996
    enddo
9996 continue
    if(info /= psb_success_)res=res+1
    call psb_spfree(a,desc_a,info)
    if (info /= psb_success_)goto 9997
9997 continue
    if(info /= psb_success_)res=res+1
    call psb_cdfree(desc_a,info)
    if (info /= psb_success_)goto 9998
9998 continue
    if(info /= psb_success_)res=res+1
9999 continue
    if(info /= psb_success_)res=res+1
    if(res /= 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha= 1 beta= 0 incx=1 incy=1 trans=n is not ok"
    if(res == 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha= 1 beta= 0 incx=1 incy=1 trans=n is ok"
  end subroutine d_usmv_2_n_ap1_bm0_ix1_iy1
  !

  subroutine d_usmv_2_t_ap1_bm0_ix1_iy1(res,afmt,ctxt)
    use psb_base_mod
    implicit none
    character(len=*) :: afmt
    type(psb_dspmat_type) :: a
    type(psb_desc_type)   :: desc_a
    type(psb_ctxt_type) :: ctxt
    integer(psb_ipk_) :: iam=-1, np=-1
    integer(psb_ipk_) :: info=-1

    integer(psb_ipk_) ::res,istat=0,i
    character::transa='t'
    integer(psb_ipk_) :: incx=1
    integer(psb_ipk_) :: incy=1
    real*8 :: alpha=1
    real*8 :: beta=0
    ! 1 0
    ! 1 0

    ! declaration of VA,IA,JA
    integer(psb_ipk_) :: nnz=2
    integer(psb_ipk_) :: m=2
    integer(psb_ipk_) :: k=2
    integer(psb_ipk_) :: IA(2)=(/1, 2/)
    integer(psb_ipk_) :: JA(2)=(/1, 1/)
    real*8 :: VA(2)=(/1, 1/)
    real*8 :: x(2)=(/1, 1/)! reference x
    real*8 :: cy(2)=(/2, 0/)! reference cy after
    real*8 :: bcy(2)=(/3, 3/)! reference bcy before
    real*8 :: y(2)=(/3, 3/)! y

    y=bcy
    res=0
    call psb_info(ctxt,iam,np)
    if(iam<0)then
      info=-1
      goto 9999
    endif
    call psb_barrier(ctxt)
    call psb_cdall(ctxt,desc_a,info,nl=m)
    if (info /= psb_success_)goto 9996
    call psb_spall(a,desc_a,info,nnz=nnz)
    if (info /= psb_success_)goto 9996
    call psb_barrier(ctxt)
    call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_cdasb(desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
    if(info.ne.0)print *,"matrix assembly failed"
    if(info.ne.0)goto 9996

    call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
    if(info.ne.0)print *,"psb_spmm failed"
    if(info.ne.0)goto 9996
    do i=1,2
      if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
      if(y(i) /= cy(i))info=-1
      if(y(i) /= cy(i))goto 9996
    enddo
9996 continue
    if(info /= psb_success_)res=res+1
    call psb_spfree(a,desc_a,info)
    if (info /= psb_success_)goto 9997
9997 continue
    if(info /= psb_success_)res=res+1
    call psb_cdfree(desc_a,info)
    if (info /= psb_success_)goto 9998
9998 continue
    if(info /= psb_success_)res=res+1
9999 continue
    if(info /= psb_success_)res=res+1
    if(res /= 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha= 1 beta= 0 incx=1 incy=1 trans=t is not ok"
    if(res == 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha= 1 beta= 0 incx=1 incy=1 trans=t is ok"
  end subroutine d_usmv_2_t_ap1_bm0_ix1_iy1
  !

  subroutine d_usmv_2_c_ap1_bm0_ix1_iy1(res,afmt,ctxt)
    use psb_base_mod
    implicit none
    character(len=*) :: afmt
    type(psb_dspmat_type) :: a
    type(psb_desc_type)   :: desc_a
    type(psb_ctxt_type) :: ctxt
    integer(psb_ipk_) :: iam=-1, np=-1
    integer(psb_ipk_) :: info=-1

    integer(psb_ipk_) ::res,istat=0,i
    character::transa='c'
    integer(psb_ipk_) :: incx=1
    integer(psb_ipk_) :: incy=1
    real*8 :: alpha=1
    real*8 :: beta=0
    ! 1 0
    ! 0 3

    ! declaration of VA,IA,JA
    integer(psb_ipk_) :: nnz=2
    integer(psb_ipk_) :: m=2
    integer(psb_ipk_) :: k=2
    integer(psb_ipk_) :: IA(2)=(/1, 2/)
    integer(psb_ipk_) :: JA(2)=(/1, 2/)
    real*8 :: VA(2)=(/1, 3/)
    real*8 :: x(2)=(/1, 1/)! reference x
    real*8 :: cy(2)=(/1, 3/)! reference cy after
    real*8 :: bcy(2)=(/3, 3/)! reference bcy before
    real*8 :: y(2)=(/3, 3/)! y

    y=bcy
    res=0
    call psb_info(ctxt,iam,np)
    if(iam<0)then
      info=-1
      goto 9999
    endif
    call psb_barrier(ctxt)
    call psb_cdall(ctxt,desc_a,info,nl=m)
    if (info /= psb_success_)goto 9996
    call psb_spall(a,desc_a,info,nnz=nnz)
    if (info /= psb_success_)goto 9996
    call psb_barrier(ctxt)
    call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_cdasb(desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
    if(info.ne.0)print *,"matrix assembly failed"
    if(info.ne.0)goto 9996

    call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
    if(info.ne.0)print *,"psb_spmm failed"
    if(info.ne.0)goto 9996
    do i=1,2
      if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
      if(y(i) /= cy(i))info=-1
      if(y(i) /= cy(i))goto 9996
    enddo
9996 continue
    if(info /= psb_success_)res=res+1
    call psb_spfree(a,desc_a,info)
    if (info /= psb_success_)goto 9997
9997 continue
    if(info /= psb_success_)res=res+1
    call psb_cdfree(desc_a,info)
    if (info /= psb_success_)goto 9998
9998 continue
    if(info /= psb_success_)res=res+1
9999 continue
    if(info /= psb_success_)res=res+1
    if(res /= 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha= 1 beta= 0 incx=1 incy=1 trans=c is not ok"
    if(res == 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha= 1 beta= 0 incx=1 incy=1 trans=c is ok"
  end subroutine d_usmv_2_c_ap1_bm0_ix1_iy1
  !

  subroutine d_usmv_2_n_am1_bp1_ix1_iy1(res,afmt,ctxt)
    use psb_base_mod
    implicit none
    character(len=*) :: afmt
    type(psb_dspmat_type) :: a
    type(psb_desc_type)   :: desc_a
    type(psb_ctxt_type) :: ctxt
    integer(psb_ipk_) :: iam=-1, np=-1
    integer(psb_ipk_) :: info=-1

    integer(psb_ipk_) ::res,istat=0,i
    character::transa='n'
    integer(psb_ipk_) :: incx=1
    integer(psb_ipk_) :: incy=1
    real*8 :: alpha=-1
    real*8 :: beta=1
    ! 1 0
    ! 0 1

    ! declaration of VA,IA,JA
    integer(psb_ipk_) :: nnz=2
    integer(psb_ipk_) :: m=2
    integer(psb_ipk_) :: k=2
    integer(psb_ipk_) :: IA(2)=(/1, 2/)
    integer(psb_ipk_) :: JA(2)=(/1, 2/)
    real*8 :: VA(2)=(/1, 1/)
    real*8 :: x(2)=(/1, 1/)! reference x
    real*8 :: cy(2)=(/2, 2/)! reference cy after
    real*8 :: bcy(2)=(/3, 3/)! reference bcy before
    real*8 :: y(2)=(/3, 3/)! y

    y=bcy
    res=0
    call psb_info(ctxt,iam,np)
    if(iam<0)then
      info=-1
      goto 9999
    endif
    call psb_barrier(ctxt)
    call psb_cdall(ctxt,desc_a,info,nl=m)
    if (info /= psb_success_)goto 9996
    call psb_spall(a,desc_a,info,nnz=nnz)
    if (info /= psb_success_)goto 9996
    call psb_barrier(ctxt)
    call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_cdasb(desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
    if(info.ne.0)print *,"matrix assembly failed"
    if(info.ne.0)goto 9996

    call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
    if(info.ne.0)print *,"psb_spmm failed"
    if(info.ne.0)goto 9996
    do i=1,2
      if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
      if(y(i) /= cy(i))info=-1
      if(y(i) /= cy(i))goto 9996
    enddo
9996 continue
    if(info /= psb_success_)res=res+1
    call psb_spfree(a,desc_a,info)
    if (info /= psb_success_)goto 9997
9997 continue
    if(info /= psb_success_)res=res+1
    call psb_cdfree(desc_a,info)
    if (info /= psb_success_)goto 9998
9998 continue
    if(info /= psb_success_)res=res+1
9999 continue
    if(info /= psb_success_)res=res+1
    if(res /= 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha=-1 beta= 1 incx=1 incy=1 trans=n is not ok"
    if(res == 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha=-1 beta= 1 incx=1 incy=1 trans=n is ok"
  end subroutine d_usmv_2_n_am1_bp1_ix1_iy1
  !

  subroutine d_usmv_2_t_am1_bp1_ix1_iy1(res,afmt,ctxt)
    use psb_base_mod
    implicit none
    character(len=*) :: afmt
    type(psb_dspmat_type) :: a
    type(psb_desc_type)   :: desc_a
    type(psb_ctxt_type) :: ctxt
    integer(psb_ipk_) :: iam=-1, np=-1
    integer(psb_ipk_) :: info=-1

    integer(psb_ipk_) ::res,istat=0,i
    character::transa='t'
    integer(psb_ipk_) :: incx=1
    integer(psb_ipk_) :: incy=1
    real*8 :: alpha=-1
    real*8 :: beta=1
    ! 1 3
    ! 1 0

    ! declaration of VA,IA,JA
    integer(psb_ipk_) :: nnz=3
    integer(psb_ipk_) :: m=2
    integer(psb_ipk_) :: k=2
    integer(psb_ipk_) :: IA(3)=(/1, 1, 2/)
    integer(psb_ipk_) :: JA(3)=(/1, 2, 1/)
    real*8 :: VA(3)=(/1, 3, 1/)
    real*8 :: x(2)=(/1, 1/)! reference x
    real*8 :: cy(2)=(/1, 0/)! reference cy after
    real*8 :: bcy(2)=(/3, 3/)! reference bcy before
    real*8 :: y(2)=(/3, 3/)! y

    y=bcy
    res=0
    call psb_info(ctxt,iam,np)
    if(iam<0)then
      info=-1
      goto 9999
    endif
    call psb_barrier(ctxt)
    call psb_cdall(ctxt,desc_a,info,nl=m)
    if (info /= psb_success_)goto 9996
    call psb_spall(a,desc_a,info,nnz=nnz)
    if (info /= psb_success_)goto 9996
    call psb_barrier(ctxt)
    call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_cdasb(desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
    if(info.ne.0)print *,"matrix assembly failed"
    if(info.ne.0)goto 9996

    call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
    if(info.ne.0)print *,"psb_spmm failed"
    if(info.ne.0)goto 9996
    do i=1,2
      if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
      if(y(i) /= cy(i))info=-1
      if(y(i) /= cy(i))goto 9996
    enddo
9996 continue
    if(info /= psb_success_)res=res+1
    call psb_spfree(a,desc_a,info)
    if (info /= psb_success_)goto 9997
9997 continue
    if(info /= psb_success_)res=res+1
    call psb_cdfree(desc_a,info)
    if (info /= psb_success_)goto 9998
9998 continue
    if(info /= psb_success_)res=res+1
9999 continue
    if(info /= psb_success_)res=res+1
    if(res /= 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha=-1 beta= 1 incx=1 incy=1 trans=t is not ok"
    if(res == 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha=-1 beta= 1 incx=1 incy=1 trans=t is ok"
  end subroutine d_usmv_2_t_am1_bp1_ix1_iy1
  !

  subroutine d_usmv_2_c_am1_bp1_ix1_iy1(res,afmt,ctxt)
    use psb_base_mod
    implicit none
    character(len=*) :: afmt
    type(psb_dspmat_type) :: a
    type(psb_desc_type)   :: desc_a
    type(psb_ctxt_type) :: ctxt
    integer(psb_ipk_) :: iam=-1, np=-1
    integer(psb_ipk_) :: info=-1

    integer(psb_ipk_) ::res,istat=0,i
    character::transa='c'
    integer(psb_ipk_) :: incx=1
    integer(psb_ipk_) :: incy=1
    real*8 :: alpha=-1
    real*8 :: beta=1
    ! 1 0
    ! 0 3

    ! declaration of VA,IA,JA
    integer(psb_ipk_) :: nnz=2
    integer(psb_ipk_) :: m=2
    integer(psb_ipk_) :: k=2
    integer(psb_ipk_) :: IA(2)=(/1, 2/)
    integer(psb_ipk_) :: JA(2)=(/1, 2/)
    real*8 :: VA(2)=(/1, 3/)
    real*8 :: x(2)=(/1, 1/)! reference x
    real*8 :: cy(2)=(/2, 0/)! reference cy after
    real*8 :: bcy(2)=(/3, 3/)! reference bcy before
    real*8 :: y(2)=(/3, 3/)! y

    y=bcy
    res=0
    call psb_info(ctxt,iam,np)
    if(iam<0)then
      info=-1
      goto 9999
    endif
    call psb_barrier(ctxt)
    call psb_cdall(ctxt,desc_a,info,nl=m)
    if (info /= psb_success_)goto 9996
    call psb_spall(a,desc_a,info,nnz=nnz)
    if (info /= psb_success_)goto 9996
    call psb_barrier(ctxt)
    call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_cdasb(desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
    if(info.ne.0)print *,"matrix assembly failed"
    if(info.ne.0)goto 9996

    call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
    if(info.ne.0)print *,"psb_spmm failed"
    if(info.ne.0)goto 9996
    do i=1,2
      if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
      if(y(i) /= cy(i))info=-1
      if(y(i) /= cy(i))goto 9996
    enddo
9996 continue
    if(info /= psb_success_)res=res+1
    call psb_spfree(a,desc_a,info)
    if (info /= psb_success_)goto 9997
9997 continue
    if(info /= psb_success_)res=res+1
    call psb_cdfree(desc_a,info)
    if (info /= psb_success_)goto 9998
9998 continue
    if(info /= psb_success_)res=res+1
9999 continue
    if(info /= psb_success_)res=res+1
    if(res /= 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha=-1 beta= 1 incx=1 incy=1 trans=c is not ok"
    if(res == 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha=-1 beta= 1 incx=1 incy=1 trans=c is ok"
  end subroutine d_usmv_2_c_am1_bp1_ix1_iy1
  !

  subroutine d_usmv_2_n_am1_bm0_ix1_iy1(res,afmt,ctxt)
    use psb_base_mod
    implicit none
    character(len=*) :: afmt
    type(psb_dspmat_type) :: a
    type(psb_desc_type)   :: desc_a
    type(psb_ctxt_type) :: ctxt
    integer(psb_ipk_) :: iam=-1, np=-1
    integer(psb_ipk_) :: info=-1

    integer(psb_ipk_) ::res,istat=0,i
    character::transa='n'
    integer(psb_ipk_) :: incx=1
    integer(psb_ipk_) :: incy=1
    real*8 :: alpha=-1
    real*8 :: beta=0
    ! 1 3
    ! 0 3

    ! declaration of VA,IA,JA
    integer(psb_ipk_) :: nnz=3
    integer(psb_ipk_) :: m=2
    integer(psb_ipk_) :: k=2
    integer(psb_ipk_) :: IA(3)=(/1, 1, 2/)
    integer(psb_ipk_) :: JA(3)=(/1, 2, 2/)
    real*8 :: VA(3)=(/1, 3, 3/)
    real*8 :: x(2)=(/1, 1/)! reference x
    real*8 :: cy(2)=(/-4, -3/)! reference cy after
    real*8 :: bcy(2)=(/3, 3/)! reference bcy before
    real*8 :: y(2)=(/3, 3/)! y

    y=bcy
    res=0
    call psb_info(ctxt,iam,np)
    if(iam<0)then
      info=-1
      goto 9999
    endif
    call psb_barrier(ctxt)
    call psb_cdall(ctxt,desc_a,info,nl=m)
    if (info /= psb_success_)goto 9996
    call psb_spall(a,desc_a,info,nnz=nnz)
    if (info /= psb_success_)goto 9996
    call psb_barrier(ctxt)
    call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_cdasb(desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
    if(info.ne.0)print *,"matrix assembly failed"
    if(info.ne.0)goto 9996

    call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
    if(info.ne.0)print *,"psb_spmm failed"
    if(info.ne.0)goto 9996
    do i=1,2
      if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
      if(y(i) /= cy(i))info=-1
      if(y(i) /= cy(i))goto 9996
    enddo
9996 continue
    if(info /= psb_success_)res=res+1
    call psb_spfree(a,desc_a,info)
    if (info /= psb_success_)goto 9997
9997 continue
    if(info /= psb_success_)res=res+1
    call psb_cdfree(desc_a,info)
    if (info /= psb_success_)goto 9998
9998 continue
    if(info /= psb_success_)res=res+1
9999 continue
    if(info /= psb_success_)res=res+1
    if(res /= 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha=-1 beta= 0 incx=1 incy=1 trans=n is not ok"
    if(res == 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha=-1 beta= 0 incx=1 incy=1 trans=n is ok"
  end subroutine d_usmv_2_n_am1_bm0_ix1_iy1
  !

  subroutine d_usmv_2_t_am1_bm0_ix1_iy1(res,afmt,ctxt)
    use psb_base_mod
    implicit none
    character(len=*) :: afmt
    type(psb_dspmat_type) :: a
    type(psb_desc_type)   :: desc_a
    type(psb_ctxt_type) :: ctxt
    integer(psb_ipk_) :: iam=-1, np=-1
    integer(psb_ipk_) :: info=-1

    integer(psb_ipk_) ::res,istat=0,i
    character::transa='t'
    integer(psb_ipk_) :: incx=1
    integer(psb_ipk_) :: incy=1
    real*8 :: alpha=-1
    real*8 :: beta=0
    ! 1 0
    ! 3 5

    ! declaration of VA,IA,JA
    integer(psb_ipk_) :: nnz=3
    integer(psb_ipk_) :: m=2
    integer(psb_ipk_) :: k=2
    integer(psb_ipk_) :: IA(3)=(/1, 2, 2/)
    integer(psb_ipk_) :: JA(3)=(/1, 1, 2/)
    real*8 :: VA(3)=(/1, 3, 5/)
    real*8 :: x(2)=(/1, 1/)! reference x
    real*8 :: cy(2)=(/-4, -5/)! reference cy after
    real*8 :: bcy(2)=(/3, 3/)! reference bcy before
    real*8 :: y(2)=(/3, 3/)! y

    y=bcy
    res=0
    call psb_info(ctxt,iam,np)
    if(iam<0)then
      info=-1
      goto 9999
    endif
    call psb_barrier(ctxt)
    call psb_cdall(ctxt,desc_a,info,nl=m)
    if (info /= psb_success_)goto 9996
    call psb_spall(a,desc_a,info,nnz=nnz)
    if (info /= psb_success_)goto 9996
    call psb_barrier(ctxt)
    call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_cdasb(desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
    if(info.ne.0)print *,"matrix assembly failed"
    if(info.ne.0)goto 9996

    call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
    if(info.ne.0)print *,"psb_spmm failed"
    if(info.ne.0)goto 9996
    do i=1,2
      if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
      if(y(i) /= cy(i))info=-1
      if(y(i) /= cy(i))goto 9996
    enddo
9996 continue
    if(info /= psb_success_)res=res+1
    call psb_spfree(a,desc_a,info)
    if (info /= psb_success_)goto 9997
9997 continue
    if(info /= psb_success_)res=res+1
    call psb_cdfree(desc_a,info)
    if (info /= psb_success_)goto 9998
9998 continue
    if(info /= psb_success_)res=res+1
9999 continue
    if(info /= psb_success_)res=res+1
    if(res /= 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha=-1 beta= 0 incx=1 incy=1 trans=t is not ok"
    if(res == 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha=-1 beta= 0 incx=1 incy=1 trans=t is ok"
  end subroutine d_usmv_2_t_am1_bm0_ix1_iy1
  !

  subroutine d_usmv_2_c_am1_bm0_ix1_iy1(res,afmt,ctxt)
    use psb_base_mod
    implicit none
    character(len=*) :: afmt
    type(psb_dspmat_type) :: a
    type(psb_desc_type)   :: desc_a
    type(psb_ctxt_type) :: ctxt
    integer(psb_ipk_) :: iam=-1, np=-1
    integer(psb_ipk_) :: info=-1

    integer(psb_ipk_) ::res,istat=0,i
    character::transa='c'
    integer(psb_ipk_) :: incx=1
    integer(psb_ipk_) :: incy=1
    real*8 :: alpha=-1
    real*8 :: beta=0
    ! 1 2
    ! 0 0

    ! declaration of VA,IA,JA
    integer(psb_ipk_) :: nnz=2
    integer(psb_ipk_) :: m=2
    integer(psb_ipk_) :: k=2
    integer(psb_ipk_) :: IA(2)=(/1, 1/)
    integer(psb_ipk_) :: JA(2)=(/1, 2/)
    real*8 :: VA(2)=(/1, 2/)
    real*8 :: x(2)=(/1, 1/)! reference x
    real*8 :: cy(2)=(/-1, -2/)! reference cy after
    real*8 :: bcy(2)=(/3, 3/)! reference bcy before
    real*8 :: y(2)=(/3, 3/)! y

    y=bcy
    res=0
    call psb_info(ctxt,iam,np)
    if(iam<0)then
      info=-1
      goto 9999
    endif
    call psb_barrier(ctxt)
    call psb_cdall(ctxt,desc_a,info,nl=m)
    if (info /= psb_success_)goto 9996
    call psb_spall(a,desc_a,info,nnz=nnz)
    if (info /= psb_success_)goto 9996
    call psb_barrier(ctxt)
    call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_cdasb(desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
    if(info.ne.0)print *,"matrix assembly failed"
    if(info.ne.0)goto 9996

    call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
    if(info.ne.0)print *,"psb_spmm failed"
    if(info.ne.0)goto 9996
    do i=1,2
      if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
      if(y(i) /= cy(i))info=-1
      if(y(i) /= cy(i))goto 9996
    enddo
9996 continue
    if(info /= psb_success_)res=res+1
    call psb_spfree(a,desc_a,info)
    if (info /= psb_success_)goto 9997
9997 continue
    if(info /= psb_success_)res=res+1
    call psb_cdfree(desc_a,info)
    if (info /= psb_success_)goto 9998
9998 continue
    if(info /= psb_success_)res=res+1
9999 continue
    if(info /= psb_success_)res=res+1
    if(res /= 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha=-1 beta= 0 incx=1 incy=1 trans=c is not ok"
    if(res == 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha=-1 beta= 0 incx=1 incy=1 trans=c is ok"
  end subroutine d_usmv_2_c_am1_bm0_ix1_iy1
  !

  subroutine d_usmv_2_n_am3_bp1_ix1_iy1(res,afmt,ctxt)
    use psb_base_mod
    implicit none
    character(len=*) :: afmt
    type(psb_dspmat_type) :: a
    type(psb_desc_type)   :: desc_a
    type(psb_ctxt_type) :: ctxt
    integer(psb_ipk_) :: iam=-1, np=-1
    integer(psb_ipk_) :: info=-1

    integer(psb_ipk_) ::res,istat=0,i
    character::transa='n'
    integer(psb_ipk_) :: incx=1
    integer(psb_ipk_) :: incy=1
    real*8 :: alpha=-3
    real*8 :: beta=1
    ! 1 0
    ! 0 6

    ! declaration of VA,IA,JA
    integer(psb_ipk_) :: nnz=2
    integer(psb_ipk_) :: m=2
    integer(psb_ipk_) :: k=2
    integer(psb_ipk_) :: IA(2)=(/1, 2/)
    integer(psb_ipk_) :: JA(2)=(/1, 2/)
    real*8 :: VA(2)=(/1, 6/)
    real*8 :: x(2)=(/1, 1/)! reference x
    real*8 :: cy(2)=(/0, -15/)! reference cy after
    real*8 :: bcy(2)=(/3, 3/)! reference bcy before
    real*8 :: y(2)=(/3, 3/)! y

    y=bcy
    res=0
    call psb_info(ctxt,iam,np)
    if(iam<0)then
      info=-1
      goto 9999
    endif
    call psb_barrier(ctxt)
    call psb_cdall(ctxt,desc_a,info,nl=m)
    if (info /= psb_success_)goto 9996
    call psb_spall(a,desc_a,info,nnz=nnz)
    if (info /= psb_success_)goto 9996
    call psb_barrier(ctxt)
    call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_cdasb(desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
    if(info.ne.0)print *,"matrix assembly failed"
    if(info.ne.0)goto 9996

    call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
    if(info.ne.0)print *,"psb_spmm failed"
    if(info.ne.0)goto 9996
    do i=1,2
      if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
      if(y(i) /= cy(i))info=-1
      if(y(i) /= cy(i))goto 9996
    enddo
9996 continue
    if(info /= psb_success_)res=res+1
    call psb_spfree(a,desc_a,info)
    if (info /= psb_success_)goto 9997
9997 continue
    if(info /= psb_success_)res=res+1
    call psb_cdfree(desc_a,info)
    if (info /= psb_success_)goto 9998
9998 continue
    if(info /= psb_success_)res=res+1
9999 continue
    if(info /= psb_success_)res=res+1
    if(res /= 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha=-3 beta= 1 incx=1 incy=1 trans=n is not ok"
    if(res == 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha=-3 beta= 1 incx=1 incy=1 trans=n is ok"
  end subroutine d_usmv_2_n_am3_bp1_ix1_iy1
  !

  subroutine d_usmv_2_t_am3_bp1_ix1_iy1(res,afmt,ctxt)
    use psb_base_mod
    implicit none
    character(len=*) :: afmt
    type(psb_dspmat_type) :: a
    type(psb_desc_type)   :: desc_a
    type(psb_ctxt_type) :: ctxt
    integer(psb_ipk_) :: iam=-1, np=-1
    integer(psb_ipk_) :: info=-1

    integer(psb_ipk_) ::res,istat=0,i
    character::transa='t'
    integer(psb_ipk_) :: incx=1
    integer(psb_ipk_) :: incy=1
    real*8 :: alpha=-3
    real*8 :: beta=1
    ! 1 2
    ! 1 3

    ! declaration of VA,IA,JA
    integer(psb_ipk_) :: nnz=4
    integer(psb_ipk_) :: m=2
    integer(psb_ipk_) :: k=2
    integer(psb_ipk_) :: IA(4)=(/1, 1, 2, 2/)
    integer(psb_ipk_) :: JA(4)=(/1, 2, 1, 2/)
    real*8 :: VA(4)=(/1, 2, 1, 3/)
    real*8 :: x(2)=(/1, 1/)! reference x
    real*8 :: cy(2)=(/-3, -12/)! reference cy after
    real*8 :: bcy(2)=(/3, 3/)! reference bcy before
    real*8 :: y(2)=(/3, 3/)! y

    y=bcy
    res=0
    call psb_info(ctxt,iam,np)
    if(iam<0)then
      info=-1
      goto 9999
    endif
    call psb_barrier(ctxt)
    call psb_cdall(ctxt,desc_a,info,nl=m)
    if (info /= psb_success_)goto 9996
    call psb_spall(a,desc_a,info,nnz=nnz)
    if (info /= psb_success_)goto 9996
    call psb_barrier(ctxt)
    call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_cdasb(desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
    if(info.ne.0)print *,"matrix assembly failed"
    if(info.ne.0)goto 9996

    call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
    if(info.ne.0)print *,"psb_spmm failed"
    if(info.ne.0)goto 9996
    do i=1,2
      if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
      if(y(i) /= cy(i))info=-1
      if(y(i) /= cy(i))goto 9996
    enddo
9996 continue
    if(info /= psb_success_)res=res+1
    call psb_spfree(a,desc_a,info)
    if (info /= psb_success_)goto 9997
9997 continue
    if(info /= psb_success_)res=res+1
    call psb_cdfree(desc_a,info)
    if (info /= psb_success_)goto 9998
9998 continue
    if(info /= psb_success_)res=res+1
9999 continue
    if(info /= psb_success_)res=res+1
    if(res /= 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha=-3 beta= 1 incx=1 incy=1 trans=t is not ok"
    if(res == 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha=-3 beta= 1 incx=1 incy=1 trans=t is ok"
  end subroutine d_usmv_2_t_am3_bp1_ix1_iy1
  !

  subroutine d_usmv_2_c_am3_bp1_ix1_iy1(res,afmt,ctxt)
    use psb_base_mod
    implicit none
    character(len=*) :: afmt
    type(psb_dspmat_type) :: a
    type(psb_desc_type)   :: desc_a
    type(psb_ctxt_type) :: ctxt
    integer(psb_ipk_) :: iam=-1, np=-1
    integer(psb_ipk_) :: info=-1

    integer(psb_ipk_) ::res,istat=0,i
    character::transa='c'
    integer(psb_ipk_) :: incx=1
    integer(psb_ipk_) :: incy=1
    real*8 :: alpha=-3
    real*8 :: beta=1
    ! 1 3
    ! 3 0

    ! declaration of VA,IA,JA
    integer(psb_ipk_) :: nnz=3
    integer(psb_ipk_) :: m=2
    integer(psb_ipk_) :: k=2
    integer(psb_ipk_) :: IA(3)=(/1, 1, 2/)
    integer(psb_ipk_) :: JA(3)=(/1, 2, 1/)
    real*8 :: VA(3)=(/1, 3, 3/)
    real*8 :: x(2)=(/1, 1/)! reference x
    real*8 :: cy(2)=(/-9, -6/)! reference cy after
    real*8 :: bcy(2)=(/3, 3/)! reference bcy before
    real*8 :: y(2)=(/3, 3/)! y

    y=bcy
    res=0
    call psb_info(ctxt,iam,np)
    if(iam<0)then
      info=-1
      goto 9999
    endif
    call psb_barrier(ctxt)
    call psb_cdall(ctxt,desc_a,info,nl=m)
    if (info /= psb_success_)goto 9996
    call psb_spall(a,desc_a,info,nnz=nnz)
    if (info /= psb_success_)goto 9996
    call psb_barrier(ctxt)
    call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_cdasb(desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
    if(info.ne.0)print *,"matrix assembly failed"
    if(info.ne.0)goto 9996

    call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
    if(info.ne.0)print *,"psb_spmm failed"
    if(info.ne.0)goto 9996
    do i=1,2
      if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
      if(y(i) /= cy(i))info=-1
      if(y(i) /= cy(i))goto 9996
    enddo
9996 continue
    if(info /= psb_success_)res=res+1
    call psb_spfree(a,desc_a,info)
    if (info /= psb_success_)goto 9997
9997 continue
    if(info /= psb_success_)res=res+1
    call psb_cdfree(desc_a,info)
    if (info /= psb_success_)goto 9998
9998 continue
    if(info /= psb_success_)res=res+1
9999 continue
    if(info /= psb_success_)res=res+1
    if(res /= 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha=-3 beta= 1 incx=1 incy=1 trans=c is not ok"
    if(res == 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha=-3 beta= 1 incx=1 incy=1 trans=c is ok"
  end subroutine d_usmv_2_c_am3_bp1_ix1_iy1
  !

  subroutine d_usmv_2_n_am3_bm0_ix1_iy1(res,afmt,ctxt)
    use psb_base_mod
    implicit none
    character(len=*) :: afmt
    type(psb_dspmat_type) :: a
    type(psb_desc_type)   :: desc_a
    type(psb_ctxt_type) :: ctxt
    integer(psb_ipk_) :: iam=-1, np=-1
    integer(psb_ipk_) :: info=-1

    integer(psb_ipk_) ::res,istat=0,i
    character::transa='n'
    integer(psb_ipk_) :: incx=1
    integer(psb_ipk_) :: incy=1
    real*8 :: alpha=-3
    real*8 :: beta=0
    ! 1 0
    ! 0 0

    ! declaration of VA,IA,JA
    integer(psb_ipk_) :: nnz=1
    integer(psb_ipk_) :: m=2
    integer(psb_ipk_) :: k=2
    integer(psb_ipk_) :: IA(1)=(/1/)
    integer(psb_ipk_) :: JA(1)=(/1/)
    real*8 :: VA(1)=(/1/)
    real*8 :: x(2)=(/1, 1/)! reference x
    real*8 :: cy(2)=(/-3, 0/)! reference cy after
    real*8 :: bcy(2)=(/3, 3/)! reference bcy before
    real*8 :: y(2)=(/3, 3/)! y

    y=bcy
    res=0
    call psb_info(ctxt,iam,np)
    if(iam<0)then
      info=-1
      goto 9999
    endif
    call psb_barrier(ctxt)
    call psb_cdall(ctxt,desc_a,info,nl=m)
    if (info /= psb_success_)goto 9996
    call psb_spall(a,desc_a,info,nnz=nnz)
    if (info /= psb_success_)goto 9996
    call psb_barrier(ctxt)
    call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_cdasb(desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
    if(info.ne.0)print *,"matrix assembly failed"
    if(info.ne.0)goto 9996

    call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
    if(info.ne.0)print *,"psb_spmm failed"
    if(info.ne.0)goto 9996
    do i=1,2
      if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
      if(y(i) /= cy(i))info=-1
      if(y(i) /= cy(i))goto 9996
    enddo
9996 continue
    if(info /= psb_success_)res=res+1
    call psb_spfree(a,desc_a,info)
    if (info /= psb_success_)goto 9997
9997 continue
    if(info /= psb_success_)res=res+1
    call psb_cdfree(desc_a,info)
    if (info /= psb_success_)goto 9998
9998 continue
    if(info /= psb_success_)res=res+1
9999 continue
    if(info /= psb_success_)res=res+1
    if(res /= 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha=-3 beta= 0 incx=1 incy=1 trans=n is not ok"
    if(res == 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha=-3 beta= 0 incx=1 incy=1 trans=n is ok"
  end subroutine d_usmv_2_n_am3_bm0_ix1_iy1
  !

  subroutine d_usmv_2_t_am3_bm0_ix1_iy1(res,afmt,ctxt)
    use psb_base_mod
    implicit none
    character(len=*) :: afmt
    type(psb_dspmat_type) :: a
    type(psb_desc_type)   :: desc_a
    type(psb_ctxt_type) :: ctxt
    integer(psb_ipk_) :: iam=-1, np=-1
    integer(psb_ipk_) :: info=-1

    integer(psb_ipk_) ::res,istat=0,i
    character::transa='t'
    integer(psb_ipk_) :: incx=1
    integer(psb_ipk_) :: incy=1
    real*8 :: alpha=-3
    real*8 :: beta=0
    ! 1 0
    ! 0 0

    ! declaration of VA,IA,JA
    integer(psb_ipk_) :: nnz=1
    integer(psb_ipk_) :: m=2
    integer(psb_ipk_) :: k=2
    integer(psb_ipk_) :: IA(1)=(/1/)
    integer(psb_ipk_) :: JA(1)=(/1/)
    real*8 :: VA(1)=(/1/)
    real*8 :: x(2)=(/1, 1/)! reference x
    real*8 :: cy(2)=(/-3, 0/)! reference cy after
    real*8 :: bcy(2)=(/3, 3/)! reference bcy before
    real*8 :: y(2)=(/3, 3/)! y

    y=bcy
    res=0
    call psb_info(ctxt,iam,np)
    if(iam<0)then
      info=-1
      goto 9999
    endif
    call psb_barrier(ctxt)
    call psb_cdall(ctxt,desc_a,info,nl=m)
    if (info /= psb_success_)goto 9996
    call psb_spall(a,desc_a,info,nnz=nnz)
    if (info /= psb_success_)goto 9996
    call psb_barrier(ctxt)
    call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_cdasb(desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
    if(info.ne.0)print *,"matrix assembly failed"
    if(info.ne.0)goto 9996

    call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
    if(info.ne.0)print *,"psb_spmm failed"
    if(info.ne.0)goto 9996
    do i=1,2
      if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
      if(y(i) /= cy(i))info=-1
      if(y(i) /= cy(i))goto 9996
    enddo
9996 continue
    if(info /= psb_success_)res=res+1
    call psb_spfree(a,desc_a,info)
    if (info /= psb_success_)goto 9997
9997 continue
    if(info /= psb_success_)res=res+1
    call psb_cdfree(desc_a,info)
    if (info /= psb_success_)goto 9998
9998 continue
    if(info /= psb_success_)res=res+1
9999 continue
    if(info /= psb_success_)res=res+1
    if(res /= 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha=-3 beta= 0 incx=1 incy=1 trans=t is not ok"
    if(res == 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha=-3 beta= 0 incx=1 incy=1 trans=t is ok"
  end subroutine d_usmv_2_t_am3_bm0_ix1_iy1
  !

  subroutine d_usmv_2_c_am3_bm0_ix1_iy1(res,afmt,ctxt)
    use psb_base_mod
    implicit none
    character(len=*) :: afmt
    type(psb_dspmat_type) :: a
    type(psb_desc_type)   :: desc_a
    type(psb_ctxt_type) :: ctxt
    integer(psb_ipk_) :: iam=-1, np=-1
    integer(psb_ipk_) :: info=-1

    integer(psb_ipk_) ::res,istat=0,i
    character::transa='c'
    integer(psb_ipk_) :: incx=1
    integer(psb_ipk_) :: incy=1
    real*8 :: alpha=-3
    real*8 :: beta=0
    ! 1 0
    ! 0 0

    ! declaration of VA,IA,JA
    integer(psb_ipk_) :: nnz=1
    integer(psb_ipk_) :: m=2
    integer(psb_ipk_) :: k=2
    integer(psb_ipk_) :: IA(1)=(/1/)
    integer(psb_ipk_) :: JA(1)=(/1/)
    real*8 :: VA(1)=(/1/)
    real*8 :: x(2)=(/1, 1/)! reference x
    real*8 :: cy(2)=(/-3, 0/)! reference cy after
    real*8 :: bcy(2)=(/3, 3/)! reference bcy before
    real*8 :: y(2)=(/3, 3/)! y

    y=bcy
    res=0
    call psb_info(ctxt,iam,np)
    if(iam<0)then
      info=-1
      goto 9999
    endif
    call psb_barrier(ctxt)
    call psb_cdall(ctxt,desc_a,info,nl=m)
    if (info /= psb_success_)goto 9996
    call psb_spall(a,desc_a,info,nnz=nnz)
    if (info /= psb_success_)goto 9996
    call psb_barrier(ctxt)
    call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_cdasb(desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
    if(info.ne.0)print *,"matrix assembly failed"
    if(info.ne.0)goto 9996

    call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
    if(info.ne.0)print *,"psb_spmm failed"
    if(info.ne.0)goto 9996
    do i=1,2
      if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
      if(y(i) /= cy(i))info=-1
      if(y(i) /= cy(i))goto 9996
    enddo
9996 continue
    if(info /= psb_success_)res=res+1
    call psb_spfree(a,desc_a,info)
    if (info /= psb_success_)goto 9997
9997 continue
    if(info /= psb_success_)res=res+1
    call psb_cdfree(desc_a,info)
    if (info /= psb_success_)goto 9998
9998 continue
    if(info /= psb_success_)res=res+1
9999 continue
    if(info /= psb_success_)res=res+1
    if(res /= 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha=-3 beta= 0 incx=1 incy=1 trans=c is not ok"
    if(res == 0)print*,"on d matrix    2 x    2 blocked   1 x   1 usmv alpha=-3 beta= 0 incx=1 incy=1 trans=c is ok"
  end subroutine d_usmv_2_c_am3_bm0_ix1_iy1
  !

  subroutine d_ussv_2_n_ap3_bm0_ix1_iy1(res,afmt,ctxt)
    use psb_base_mod
    implicit none
    character(len=*) :: afmt
    type(psb_dspmat_type) :: a
    type(psb_desc_type)   :: desc_a
    type(psb_ctxt_type) :: ctxt
    integer(psb_ipk_) :: iam=-1, np=-1
    integer(psb_ipk_) :: info=-1

    integer(psb_ipk_) ::res,istat=0,i
    character::transa='n'
    integer(psb_ipk_) :: incx=1
    real*8 :: alpha=3
    real*8 :: beta=0
    ! 1 0
    ! 3 1

    ! declaration of VA,IA,JA
    integer(psb_ipk_) :: nnz=3
    integer(psb_ipk_) :: m=2
    integer(psb_ipk_) :: k=2
    integer(psb_ipk_) :: IA(3)=(/1, 2, 2/)
    integer(psb_ipk_) :: JA(3)=(/1, 1, 2/)
    real*8 :: VA(3)=(/1, 3, 1/)
    real*8 :: x(2)=(/3, 12/)! reference x
    real*8 :: cy(2)=(/9, 9/)! reference cy after
    real*8 :: bcy(2)=(/0, 0/)! reference bcy before
    real*8 :: y(2)=(/0, 0/)! y

    y=bcy
    res=0
    call psb_info(ctxt,iam,np)
    if(iam<0)then
      info=-1
      goto 9999
    endif
    call psb_barrier(ctxt)
    call psb_cdall(ctxt,desc_a,info,nl=m)
    if (info /= psb_success_)goto 9996
    call psb_spall(a,desc_a,info,nnz=nnz)
    if (info /= psb_success_)goto 9996
    call a%set_triangle()
    call a%set_lower()
    call a%set_unit(.false.)

    call psb_barrier(ctxt)
    call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_cdasb(desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
    if(info.ne.0)print *,"matrix assembly failed"
    if(info.ne.0)goto 9996

    call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa)
    if(info.ne.0)print *,"psb_spsm failed"
    if(info.ne.0)goto 9996
    do i=1,2
      if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
      if(y(i) /= cy(i))info=-1
      if(y(i) /= cy(i))goto 9996
    enddo
9996 continue
    if(info /= psb_success_)res=res+1
    call psb_spfree(a,desc_a,info)
    if (info /= psb_success_)goto 9997
9997 continue
    if(info /= psb_success_)res=res+1
    call psb_cdfree(desc_a,info)
    if (info /= psb_success_)goto 9998
9998 continue
    if(info /= psb_success_)res=res+1
9999 continue
    if(info /= psb_success_)res=res+1
    if(res /= 0)print*,"on d matrix    2 x    2 blocked   1 x   1 ussv alpha= 3 beta= 0 incx=1 incy=1 trans=n is not ok"
    if(res == 0)print*,"on d matrix    2 x    2 blocked   1 x   1 ussv alpha= 3 beta= 0 incx=1 incy=1 trans=n is ok"
  end subroutine d_ussv_2_n_ap3_bm0_ix1_iy1
  !

  subroutine d_ussv_2_t_ap3_bm0_ix1_iy1(res,afmt,ctxt)
    use psb_base_mod
    implicit none
    character(len=*) :: afmt
    type(psb_dspmat_type) :: a
    type(psb_desc_type)   :: desc_a
    type(psb_ctxt_type) :: ctxt
    integer(psb_ipk_) :: iam=-1, np=-1
    integer(psb_ipk_) :: info=-1

    integer(psb_ipk_) ::res,istat=0,i
    character::transa='t'
    integer(psb_ipk_) :: incx=1
    real*8 :: alpha=3
    real*8 :: beta=0
    ! 1 0
    ! 2 1

    ! declaration of VA,IA,JA
    integer(psb_ipk_) :: nnz=3
    integer(psb_ipk_) :: m=2
    integer(psb_ipk_) :: k=2
    integer(psb_ipk_) :: IA(3)=(/1, 2, 2/)
    integer(psb_ipk_) :: JA(3)=(/1, 1, 2/)
    real*8 :: VA(3)=(/1, 2, 1/)
    real*8 :: x(2)=(/9, 3/)! reference x
    real*8 :: cy(2)=(/9, 9/)! reference cy after
    real*8 :: bcy(2)=(/0, 0/)! reference bcy before
    real*8 :: y(2)=(/0, 0/)! y

    y=bcy
    res=0
    call psb_info(ctxt,iam,np)
    if(iam<0)then
      info=-1
      goto 9999
    endif
    call psb_barrier(ctxt)
    call psb_cdall(ctxt,desc_a,info,nl=m)
    if (info /= psb_success_)goto 9996
    call psb_spall(a,desc_a,info,nnz=nnz)
    if (info /= psb_success_)goto 9996
    call a%set_triangle()
    call a%set_lower()
    call a%set_unit(.false.)

    call psb_barrier(ctxt)
    call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_cdasb(desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
    if(info.ne.0)print *,"matrix assembly failed"
    if(info.ne.0)goto 9996

    call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa)
    if(info.ne.0)print *,"psb_spsm failed"
    if(info.ne.0)goto 9996
    do i=1,2
      if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
      if(y(i) /= cy(i))info=-1
      if(y(i) /= cy(i))goto 9996
    enddo
9996 continue
    if(info /= psb_success_)res=res+1
    call psb_spfree(a,desc_a,info)
    if (info /= psb_success_)goto 9997
9997 continue
    if(info /= psb_success_)res=res+1
    call psb_cdfree(desc_a,info)
    if (info /= psb_success_)goto 9998
9998 continue
    if(info /= psb_success_)res=res+1
9999 continue
    if(info /= psb_success_)res=res+1
    if(res /= 0)print*,"on d matrix    2 x    2 blocked   1 x   1 ussv alpha= 3 beta= 0 incx=1 incy=1 trans=t is not ok"
    if(res == 0)print*,"on d matrix    2 x    2 blocked   1 x   1 ussv alpha= 3 beta= 0 incx=1 incy=1 trans=t is ok"
  end subroutine d_ussv_2_t_ap3_bm0_ix1_iy1
  !

  subroutine d_ussv_2_c_ap3_bm0_ix1_iy1(res,afmt,ctxt)
    use psb_base_mod
    implicit none
    character(len=*) :: afmt
    type(psb_dspmat_type) :: a
    type(psb_desc_type)   :: desc_a
    type(psb_ctxt_type) :: ctxt
    integer(psb_ipk_) :: iam=-1, np=-1
    integer(psb_ipk_) :: info=-1

    integer(psb_ipk_) ::res,istat=0,i
    character::transa='c'
    integer(psb_ipk_) :: incx=1
    real*8 :: alpha=3
    real*8 :: beta=0
    ! 1 0
    ! 3 1

    ! declaration of VA,IA,JA
    integer(psb_ipk_) :: nnz=3
    integer(psb_ipk_) :: m=2
    integer(psb_ipk_) :: k=2
    integer(psb_ipk_) :: IA(3)=(/1, 2, 2/)
    integer(psb_ipk_) :: JA(3)=(/1, 1, 2/)
    real*8 :: VA(3)=(/1, 3, 1/)
    real*8 :: x(2)=(/12, 3/)! reference x
    real*8 :: cy(2)=(/9, 9/)! reference cy after
    real*8 :: bcy(2)=(/0, 0/)! reference bcy before
    real*8 :: y(2)=(/0, 0/)! y

    y=bcy
    res=0
    call psb_info(ctxt,iam,np)
    if(iam<0)then
      info=-1
      goto 9999
    endif
    call psb_barrier(ctxt)
    call psb_cdall(ctxt,desc_a,info,nl=m)
    if (info /= psb_success_)goto 9996
    call psb_spall(a,desc_a,info,nnz=nnz)
    if (info /= psb_success_)goto 9996
    call a%set_triangle()
    call a%set_lower()
    call a%set_unit(.false.)

    call psb_barrier(ctxt)
    call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_cdasb(desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
    if(info.ne.0)print *,"matrix assembly failed"
    if(info.ne.0)goto 9996

    call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa)
    if(info.ne.0)print *,"psb_spsm failed"
    if(info.ne.0)goto 9996
    do i=1,2
      if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
      if(y(i) /= cy(i))info=-1
      if(y(i) /= cy(i))goto 9996
    enddo
9996 continue
    if(info /= psb_success_)res=res+1
    call psb_spfree(a,desc_a,info)
    if (info /= psb_success_)goto 9997
9997 continue
    if(info /= psb_success_)res=res+1
    call psb_cdfree(desc_a,info)
    if (info /= psb_success_)goto 9998
9998 continue
    if(info /= psb_success_)res=res+1
9999 continue
    if(info /= psb_success_)res=res+1
    if(res /= 0)print*,"on d matrix    2 x    2 blocked   1 x   1 ussv alpha= 3 beta= 0 incx=1 incy=1 trans=c is not ok"
    if(res == 0)print*,"on d matrix    2 x    2 blocked   1 x   1 ussv alpha= 3 beta= 0 incx=1 incy=1 trans=c is ok"
  end subroutine d_ussv_2_c_ap3_bm0_ix1_iy1
  !

  subroutine d_ussv_2_n_ap1_bm0_ix1_iy1(res,afmt,ctxt)
    use psb_base_mod
    implicit none
    character(len=*) :: afmt
    type(psb_dspmat_type) :: a
    type(psb_desc_type)   :: desc_a
    type(psb_ctxt_type) :: ctxt
    integer(psb_ipk_) :: iam=-1, np=-1
    integer(psb_ipk_) :: info=-1

    integer(psb_ipk_) ::res,istat=0,i
    character::transa='n'
    integer(psb_ipk_) :: incx=1
    real*8 :: alpha=1
    real*8 :: beta=0
    ! 1 0
    ! 3 1

    ! declaration of VA,IA,JA
    integer(psb_ipk_) :: nnz=3
    integer(psb_ipk_) :: m=2
    integer(psb_ipk_) :: k=2
    integer(psb_ipk_) :: IA(3)=(/1, 2, 2/)
    integer(psb_ipk_) :: JA(3)=(/1, 1, 2/)
    real*8 :: VA(3)=(/1, 3, 1/)
    real*8 :: x(2)=(/1, 4/)! reference x
    real*8 :: cy(2)=(/1, 1/)! reference cy after
    real*8 :: bcy(2)=(/0, 0/)! reference bcy before
    real*8 :: y(2)=(/0, 0/)! y

    y=bcy
    res=0
    call psb_info(ctxt,iam,np)
    if(iam<0)then
      info=-1
      goto 9999
    endif
    call psb_barrier(ctxt)
    call psb_cdall(ctxt,desc_a,info,nl=m)
    if (info /= psb_success_)goto 9996
    call psb_spall(a,desc_a,info,nnz=nnz)
    if (info /= psb_success_)goto 9996
    call a%set_triangle()
    call a%set_lower()
    call a%set_unit(.false.)

    call psb_barrier(ctxt)
    call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_cdasb(desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
    if(info.ne.0)print *,"matrix assembly failed"
    if(info.ne.0)goto 9996

    call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa)
    if(info.ne.0)print *,"psb_spsm failed"
    if(info.ne.0)goto 9996
    do i=1,2
      if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
      if(y(i) /= cy(i))info=-1
      if(y(i) /= cy(i))goto 9996
    enddo
9996 continue
    if(info /= psb_success_)res=res+1
    call psb_spfree(a,desc_a,info)
    if (info /= psb_success_)goto 9997
9997 continue
    if(info /= psb_success_)res=res+1
    call psb_cdfree(desc_a,info)
    if (info /= psb_success_)goto 9998
9998 continue
    if(info /= psb_success_)res=res+1
9999 continue
    if(info /= psb_success_)res=res+1
    if(res /= 0)print*,"on d matrix    2 x    2 blocked   1 x   1 ussv alpha= 1 beta= 0 incx=1 incy=1 trans=n is not ok"
    if(res == 0)print*,"on d matrix    2 x    2 blocked   1 x   1 ussv alpha= 1 beta= 0 incx=1 incy=1 trans=n is ok"
  end subroutine d_ussv_2_n_ap1_bm0_ix1_iy1
  !

  subroutine d_ussv_2_t_ap1_bm0_ix1_iy1(res,afmt,ctxt)
    use psb_base_mod
    implicit none
    character(len=*) :: afmt
    type(psb_dspmat_type) :: a
    type(psb_desc_type)   :: desc_a
    type(psb_ctxt_type) :: ctxt
    integer(psb_ipk_) :: iam=-1, np=-1
    integer(psb_ipk_) :: info=-1

    integer(psb_ipk_) ::res,istat=0,i
    character::transa='t'
    integer(psb_ipk_) :: incx=1
    real*8 :: alpha=1
    real*8 :: beta=0
    ! 1 0
    ! 1 1

    ! declaration of VA,IA,JA
    integer(psb_ipk_) :: nnz=3
    integer(psb_ipk_) :: m=2
    integer(psb_ipk_) :: k=2
    integer(psb_ipk_) :: IA(3)=(/1, 2, 2/)
    integer(psb_ipk_) :: JA(3)=(/1, 1, 2/)
    real*8 :: VA(3)=(/1, 1, 1/)
    real*8 :: x(2)=(/2, 1/)! reference x
    real*8 :: cy(2)=(/1, 1/)! reference cy after
    real*8 :: bcy(2)=(/0, 0/)! reference bcy before
    real*8 :: y(2)=(/0, 0/)! y

    y=bcy
    res=0
    call psb_info(ctxt,iam,np)
    if(iam<0)then
      info=-1
      goto 9999
    endif
    call psb_barrier(ctxt)
    call psb_cdall(ctxt,desc_a,info,nl=m)
    if (info /= psb_success_)goto 9996
    call psb_spall(a,desc_a,info,nnz=nnz)
    if (info /= psb_success_)goto 9996
    call a%set_triangle()
    call a%set_lower()
    call a%set_unit(.false.)

    call psb_barrier(ctxt)
    call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_cdasb(desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
    if(info.ne.0)print *,"matrix assembly failed"
    if(info.ne.0)goto 9996

    call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa)
    if(info.ne.0)print *,"psb_spsm failed"
    if(info.ne.0)goto 9996
    do i=1,2
      if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
      if(y(i) /= cy(i))info=-1
      if(y(i) /= cy(i))goto 9996
    enddo
9996 continue
    if(info /= psb_success_)res=res+1
    call psb_spfree(a,desc_a,info)
    if (info /= psb_success_)goto 9997
9997 continue
    if(info /= psb_success_)res=res+1
    call psb_cdfree(desc_a,info)
    if (info /= psb_success_)goto 9998
9998 continue
    if(info /= psb_success_)res=res+1
9999 continue
    if(info /= psb_success_)res=res+1
    if(res /= 0)print*,"on d matrix    2 x    2 blocked   1 x   1 ussv alpha= 1 beta= 0 incx=1 incy=1 trans=t is not ok"
    if(res == 0)print*,"on d matrix    2 x    2 blocked   1 x   1 ussv alpha= 1 beta= 0 incx=1 incy=1 trans=t is ok"
  end subroutine d_ussv_2_t_ap1_bm0_ix1_iy1
  !

  subroutine d_ussv_2_c_ap1_bm0_ix1_iy1(res,afmt,ctxt)
    use psb_base_mod
    implicit none
    character(len=*) :: afmt
    type(psb_dspmat_type) :: a
    type(psb_desc_type)   :: desc_a
    type(psb_ctxt_type) :: ctxt
    integer(psb_ipk_) :: iam=-1, np=-1
    integer(psb_ipk_) :: info=-1

    integer(psb_ipk_) ::res,istat=0,i
    character::transa='c'
    integer(psb_ipk_) :: incx=1
    real*8 :: alpha=1
    real*8 :: beta=0
    ! 1 0
    ! 0 1

    ! declaration of VA,IA,JA
    integer(psb_ipk_) :: nnz=2
    integer(psb_ipk_) :: m=2
    integer(psb_ipk_) :: k=2
    integer(psb_ipk_) :: IA(2)=(/1, 2/)
    integer(psb_ipk_) :: JA(2)=(/1, 2/)
    real*8 :: VA(2)=(/1, 1/)
    real*8 :: x(2)=(/1, 1/)! reference x
    real*8 :: cy(2)=(/1, 1/)! reference cy after
    real*8 :: bcy(2)=(/0, 0/)! reference bcy before
    real*8 :: y(2)=(/0, 0/)! y

    y=bcy
    res=0
    call psb_info(ctxt,iam,np)
    if(iam<0)then
      info=-1
      goto 9999
    endif
    call psb_barrier(ctxt)
    call psb_cdall(ctxt,desc_a,info,nl=m)
    if (info /= psb_success_)goto 9996
    call psb_spall(a,desc_a,info,nnz=nnz)
    if (info /= psb_success_)goto 9996
    call a%set_triangle()
    call a%set_lower()
    call a%set_unit(.false.)

    call psb_barrier(ctxt)
    call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_cdasb(desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
    if(info.ne.0)print *,"matrix assembly failed"
    if(info.ne.0)goto 9996

    call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa)
    if(info.ne.0)print *,"psb_spsm failed"
    if(info.ne.0)goto 9996
    do i=1,2
      if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
      if(y(i) /= cy(i))info=-1
      if(y(i) /= cy(i))goto 9996
    enddo
9996 continue
    if(info /= psb_success_)res=res+1
    call psb_spfree(a,desc_a,info)
    if (info /= psb_success_)goto 9997
9997 continue
    if(info /= psb_success_)res=res+1
    call psb_cdfree(desc_a,info)
    if (info /= psb_success_)goto 9998
9998 continue
    if(info /= psb_success_)res=res+1
9999 continue
    if(info /= psb_success_)res=res+1
    if(res /= 0)print*,"on d matrix    2 x    2 blocked   1 x   1 ussv alpha= 1 beta= 0 incx=1 incy=1 trans=c is not ok"
    if(res == 0)print*,"on d matrix    2 x    2 blocked   1 x   1 ussv alpha= 1 beta= 0 incx=1 incy=1 trans=c is ok"
  end subroutine d_ussv_2_c_ap1_bm0_ix1_iy1
  !

  subroutine d_ussv_2_n_am1_bm0_ix1_iy1(res,afmt,ctxt)
    use psb_base_mod
    implicit none
    character(len=*) :: afmt
    type(psb_dspmat_type) :: a
    type(psb_desc_type)   :: desc_a
    type(psb_ctxt_type) :: ctxt
    integer(psb_ipk_) :: iam=-1, np=-1
    integer(psb_ipk_) :: info=-1

    integer(psb_ipk_) ::res,istat=0,i
    character::transa='n'
    integer(psb_ipk_) :: incx=1
    real*8 :: alpha=-1
    real*8 :: beta=0
    ! 1 0
    ! 1 1

    ! declaration of VA,IA,JA
    integer(psb_ipk_) :: nnz=3
    integer(psb_ipk_) :: m=2
    integer(psb_ipk_) :: k=2
    integer(psb_ipk_) :: IA(3)=(/1, 2, 2/)
    integer(psb_ipk_) :: JA(3)=(/1, 1, 2/)
    real*8 :: VA(3)=(/1, 1, 1/)
    real*8 :: x(2)=(/-1, -2/)! reference x
    real*8 :: cy(2)=(/1, 1/)! reference cy after
    real*8 :: bcy(2)=(/0, 0/)! reference bcy before
    real*8 :: y(2)=(/0, 0/)! y

    y=bcy
    res=0
    call psb_info(ctxt,iam,np)
    if(iam<0)then
      info=-1
      goto 9999
    endif
    call psb_barrier(ctxt)
    call psb_cdall(ctxt,desc_a,info,nl=m)
    if (info /= psb_success_)goto 9996
    call psb_spall(a,desc_a,info,nnz=nnz)
    if (info /= psb_success_)goto 9996
    call a%set_triangle()
    call a%set_lower()
    call a%set_unit(.false.)

    call psb_barrier(ctxt)
    call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_cdasb(desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
    if(info.ne.0)print *,"matrix assembly failed"
    if(info.ne.0)goto 9996

    call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa)
    if(info.ne.0)print *,"psb_spsm failed"
    if(info.ne.0)goto 9996
    do i=1,2
      if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
      if(y(i) /= cy(i))info=-1
      if(y(i) /= cy(i))goto 9996
    enddo
9996 continue
    if(info /= psb_success_)res=res+1
    call psb_spfree(a,desc_a,info)
    if (info /= psb_success_)goto 9997
9997 continue
    if(info /= psb_success_)res=res+1
    call psb_cdfree(desc_a,info)
    if (info /= psb_success_)goto 9998
9998 continue
    if(info /= psb_success_)res=res+1
9999 continue
    if(info /= psb_success_)res=res+1
    if(res /= 0)print*,"on d matrix    2 x    2 blocked   1 x   1 ussv alpha=-1 beta= 0 incx=1 incy=1 trans=n is not ok"
    if(res == 0)print*,"on d matrix    2 x    2 blocked   1 x   1 ussv alpha=-1 beta= 0 incx=1 incy=1 trans=n is ok"
  end subroutine d_ussv_2_n_am1_bm0_ix1_iy1
  !

  subroutine d_ussv_2_t_am1_bm0_ix1_iy1(res,afmt,ctxt)
    use psb_base_mod
    implicit none
    character(len=*) :: afmt
    type(psb_dspmat_type) :: a
    type(psb_desc_type)   :: desc_a
    type(psb_ctxt_type) :: ctxt
    integer(psb_ipk_) :: iam=-1, np=-1
    integer(psb_ipk_) :: info=-1

    integer(psb_ipk_) ::res,istat=0,i
    character::transa='t'
    integer(psb_ipk_) :: incx=1
    real*8 :: alpha=-1
    real*8 :: beta=0
    ! 1 0
    ! 6 1

    ! declaration of VA,IA,JA
    integer(psb_ipk_) :: nnz=3
    integer(psb_ipk_) :: m=2
    integer(psb_ipk_) :: k=2
    integer(psb_ipk_) :: IA(3)=(/1, 2, 2/)
    integer(psb_ipk_) :: JA(3)=(/1, 1, 2/)
    real*8 :: VA(3)=(/1, 6, 1/)
    real*8 :: x(2)=(/-7, -1/)! reference x
    real*8 :: cy(2)=(/1, 1/)! reference cy after
    real*8 :: bcy(2)=(/0, 0/)! reference bcy before
    real*8 :: y(2)=(/0, 0/)! y

    y=bcy
    res=0
    call psb_info(ctxt,iam,np)
    if(iam<0)then
      info=-1
      goto 9999
    endif
    call psb_barrier(ctxt)
    call psb_cdall(ctxt,desc_a,info,nl=m)
    if (info /= psb_success_)goto 9996
    call psb_spall(a,desc_a,info,nnz=nnz)
    if (info /= psb_success_)goto 9996
    call a%set_triangle()
    call a%set_lower()
    call a%set_unit(.false.)

    call psb_barrier(ctxt)
    call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_cdasb(desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
    if(info.ne.0)print *,"matrix assembly failed"
    if(info.ne.0)goto 9996

    call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa)
    if(info.ne.0)print *,"psb_spsm failed"
    if(info.ne.0)goto 9996
    do i=1,2
      if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
      if(y(i) /= cy(i))info=-1
      if(y(i) /= cy(i))goto 9996
    enddo
9996 continue
    if(info /= psb_success_)res=res+1
    call psb_spfree(a,desc_a,info)
    if (info /= psb_success_)goto 9997
9997 continue
    if(info /= psb_success_)res=res+1
    call psb_cdfree(desc_a,info)
    if (info /= psb_success_)goto 9998
9998 continue
    if(info /= psb_success_)res=res+1
9999 continue
    if(info /= psb_success_)res=res+1
    if(res /= 0)print*,"on d matrix    2 x    2 blocked   1 x   1 ussv alpha=-1 beta= 0 incx=1 incy=1 trans=t is not ok"
    if(res == 0)print*,"on d matrix    2 x    2 blocked   1 x   1 ussv alpha=-1 beta= 0 incx=1 incy=1 trans=t is ok"
  end subroutine d_ussv_2_t_am1_bm0_ix1_iy1
  !

  subroutine d_ussv_2_c_am1_bm0_ix1_iy1(res,afmt,ctxt)
    use psb_base_mod
    implicit none
    character(len=*) :: afmt
    type(psb_dspmat_type) :: a
    type(psb_desc_type)   :: desc_a
    type(psb_ctxt_type) :: ctxt
    integer(psb_ipk_) :: iam=-1, np=-1
    integer(psb_ipk_) :: info=-1

    integer(psb_ipk_) ::res,istat=0,i
    character::transa='c'
    integer(psb_ipk_) :: incx=1
    real*8 :: alpha=-1
    real*8 :: beta=0
    ! 1 0
    ! 2 1

    ! declaration of VA,IA,JA
    integer(psb_ipk_) :: nnz=3
    integer(psb_ipk_) :: m=2
    integer(psb_ipk_) :: k=2
    integer(psb_ipk_) :: IA(3)=(/1, 2, 2/)
    integer(psb_ipk_) :: JA(3)=(/1, 1, 2/)
    real*8 :: VA(3)=(/1, 2, 1/)
    real*8 :: x(2)=(/-3, -1/)! reference x
    real*8 :: cy(2)=(/1, 1/)! reference cy after
    real*8 :: bcy(2)=(/0, 0/)! reference bcy before
    real*8 :: y(2)=(/0, 0/)! y

    y=bcy
    res=0
    call psb_info(ctxt,iam,np)
    if(iam<0)then
      info=-1
      goto 9999
    endif
    call psb_barrier(ctxt)
    call psb_cdall(ctxt,desc_a,info,nl=m)
    if (info /= psb_success_)goto 9996
    call psb_spall(a,desc_a,info,nnz=nnz)
    if (info /= psb_success_)goto 9996
    call a%set_triangle()
    call a%set_lower()
    call a%set_unit(.false.)

    call psb_barrier(ctxt)
    call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_cdasb(desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
    if(info.ne.0)print *,"matrix assembly failed"
    if(info.ne.0)goto 9996

    call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa)
    if(info.ne.0)print *,"psb_spsm failed"
    if(info.ne.0)goto 9996
    do i=1,2
      if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
      if(y(i) /= cy(i))info=-1
      if(y(i) /= cy(i))goto 9996
    enddo
9996 continue
    if(info /= psb_success_)res=res+1
    call psb_spfree(a,desc_a,info)
    if (info /= psb_success_)goto 9997
9997 continue
    if(info /= psb_success_)res=res+1
    call psb_cdfree(desc_a,info)
    if (info /= psb_success_)goto 9998
9998 continue
    if(info /= psb_success_)res=res+1
9999 continue
    if(info /= psb_success_)res=res+1
    if(res /= 0)print*,"on d matrix    2 x    2 blocked   1 x   1 ussv alpha=-1 beta= 0 incx=1 incy=1 trans=c is not ok"
    if(res == 0)print*,"on d matrix    2 x    2 blocked   1 x   1 ussv alpha=-1 beta= 0 incx=1 incy=1 trans=c is ok"
  end subroutine d_ussv_2_c_am1_bm0_ix1_iy1
  !

  subroutine d_ussv_2_n_am3_bm0_ix1_iy1(res,afmt,ctxt)
    use psb_base_mod
    implicit none
    character(len=*) :: afmt
    type(psb_dspmat_type) :: a
    type(psb_desc_type)   :: desc_a
    type(psb_ctxt_type) :: ctxt
    integer(psb_ipk_) :: iam=-1, np=-1
    integer(psb_ipk_) :: info=-1

    integer(psb_ipk_) ::res,istat=0,i
    character::transa='n'
    integer(psb_ipk_) :: incx=1
    real*8 :: alpha=-3
    real*8 :: beta=0
    ! 1 0
    ! 1 1

    ! declaration of VA,IA,JA
    integer(psb_ipk_) :: nnz=3
    integer(psb_ipk_) :: m=2
    integer(psb_ipk_) :: k=2
    integer(psb_ipk_) :: IA(3)=(/1, 2, 2/)
    integer(psb_ipk_) :: JA(3)=(/1, 1, 2/)
    real*8 :: VA(3)=(/1, 1, 1/)
    real*8 :: x(2)=(/-3, -6/)! reference x
    real*8 :: cy(2)=(/9, 9/)! reference cy after
    real*8 :: bcy(2)=(/0, 0/)! reference bcy before
    real*8 :: y(2)=(/0, 0/)! y

    y=bcy
    res=0
    call psb_info(ctxt,iam,np)
    if(iam<0)then
      info=-1
      goto 9999
    endif
    call psb_barrier(ctxt)
    call psb_cdall(ctxt,desc_a,info,nl=m)
    if (info /= psb_success_)goto 9996
    call psb_spall(a,desc_a,info,nnz=nnz)
    if (info /= psb_success_)goto 9996
    call a%set_triangle()
    call a%set_lower()
    call a%set_unit(.false.)

    call psb_barrier(ctxt)
    call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_cdasb(desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
    if(info.ne.0)print *,"matrix assembly failed"
    if(info.ne.0)goto 9996

    call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa)
    if(info.ne.0)print *,"psb_spsm failed"
    if(info.ne.0)goto 9996
    do i=1,2
      if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
      if(y(i) /= cy(i))info=-1
      if(y(i) /= cy(i))goto 9996
    enddo
9996 continue
    if(info /= psb_success_)res=res+1
    call psb_spfree(a,desc_a,info)
    if (info /= psb_success_)goto 9997
9997 continue
    if(info /= psb_success_)res=res+1
    call psb_cdfree(desc_a,info)
    if (info /= psb_success_)goto 9998
9998 continue
    if(info /= psb_success_)res=res+1
9999 continue
    if(info /= psb_success_)res=res+1
    if(res /= 0)print*,"on d matrix    2 x    2 blocked   1 x   1 ussv alpha=-3 beta= 0 incx=1 incy=1 trans=n is not ok"
    if(res == 0)print*,"on d matrix    2 x    2 blocked   1 x   1 ussv alpha=-3 beta= 0 incx=1 incy=1 trans=n is ok"
  end subroutine d_ussv_2_n_am3_bm0_ix1_iy1
  !

  subroutine d_ussv_2_t_am3_bm0_ix1_iy1(res,afmt,ctxt)
    use psb_base_mod
    implicit none
    character(len=*) :: afmt
    type(psb_dspmat_type) :: a
    type(psb_desc_type)   :: desc_a
    type(psb_ctxt_type) :: ctxt
    integer(psb_ipk_) :: iam=-1, np=-1
    integer(psb_ipk_) :: info=-1

    integer(psb_ipk_) ::res,istat=0,i
    character::transa='t'
    integer(psb_ipk_) :: incx=1
    real*8 :: alpha=-3
    real*8 :: beta=0
    ! 1 0
    ! 0 1

    ! declaration of VA,IA,JA
    integer(psb_ipk_) :: nnz=2
    integer(psb_ipk_) :: m=2
    integer(psb_ipk_) :: k=2
    integer(psb_ipk_) :: IA(2)=(/1, 2/)
    integer(psb_ipk_) :: JA(2)=(/1, 2/)
    real*8 :: VA(2)=(/1, 1/)
    real*8 :: x(2)=(/-3, -3/)! reference x
    real*8 :: cy(2)=(/9, 9/)! reference cy after
    real*8 :: bcy(2)=(/0, 0/)! reference bcy before
    real*8 :: y(2)=(/0, 0/)! y

    y=bcy
    res=0
    call psb_info(ctxt,iam,np)
    if(iam<0)then
      info=-1
      goto 9999
    endif
    call psb_barrier(ctxt)
    call psb_cdall(ctxt,desc_a,info,nl=m)
    if (info /= psb_success_)goto 9996
    call psb_spall(a,desc_a,info,nnz=nnz)
    if (info /= psb_success_)goto 9996
    call a%set_triangle()
    call a%set_lower()
    call a%set_unit(.false.)

    call psb_barrier(ctxt)
    call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_cdasb(desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
    if(info.ne.0)print *,"matrix assembly failed"
    if(info.ne.0)goto 9996

    call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa)
    if(info.ne.0)print *,"psb_spsm failed"
    if(info.ne.0)goto 9996
    do i=1,2
      if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
      if(y(i) /= cy(i))info=-1
      if(y(i) /= cy(i))goto 9996
    enddo
9996 continue
    if(info /= psb_success_)res=res+1
    call psb_spfree(a,desc_a,info)
    if (info /= psb_success_)goto 9997
9997 continue
    if(info /= psb_success_)res=res+1
    call psb_cdfree(desc_a,info)
    if (info /= psb_success_)goto 9998
9998 continue
    if(info /= psb_success_)res=res+1
9999 continue
    if(info /= psb_success_)res=res+1
    if(res /= 0)print*,"on d matrix    2 x    2 blocked   1 x   1 ussv alpha=-3 beta= 0 incx=1 incy=1 trans=t is not ok"
    if(res == 0)print*,"on d matrix    2 x    2 blocked   1 x   1 ussv alpha=-3 beta= 0 incx=1 incy=1 trans=t is ok"
  end subroutine d_ussv_2_t_am3_bm0_ix1_iy1
  !

  subroutine d_ussv_2_c_am3_bm0_ix1_iy1(res,afmt,ctxt)
    use psb_base_mod
    implicit none
    character(len=*) :: afmt
    type(psb_dspmat_type) :: a
    type(psb_desc_type)   :: desc_a
    type(psb_ctxt_type) :: ctxt
    integer(psb_ipk_) :: iam=-1, np=-1
    integer(psb_ipk_) :: info=-1

    integer(psb_ipk_) ::res,istat=0,i
    character::transa='c'
    integer(psb_ipk_) :: incx=1
    real*8 :: alpha=-3
    real*8 :: beta=0
    ! 1 0
    ! 0 1

    ! declaration of VA,IA,JA
    integer(psb_ipk_) :: nnz=2
    integer(psb_ipk_) :: m=2
    integer(psb_ipk_) :: k=2
    integer(psb_ipk_) :: IA(2)=(/1, 2/)
    integer(psb_ipk_) :: JA(2)=(/1, 2/)
    real*8 :: VA(2)=(/1, 1/)
    real*8 :: x(2)=(/-3, -3/)! reference x
    real*8 :: cy(2)=(/9, 9/)! reference cy after
    real*8 :: bcy(2)=(/0, 0/)! reference bcy before
    real*8 :: y(2)=(/0, 0/)! y

    y=bcy
    res=0
    call psb_info(ctxt,iam,np)
    if(iam<0)then
      info=-1
      goto 9999
    endif
    call psb_barrier(ctxt)
    call psb_cdall(ctxt,desc_a,info,nl=m)
    if (info /= psb_success_)goto 9996
    call psb_spall(a,desc_a,info,nnz=nnz)
    if (info /= psb_success_)goto 9996
    call a%set_triangle()
    call a%set_lower()
    call a%set_unit(.false.)

    call psb_barrier(ctxt)
    call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_cdasb(desc_a,info)
    if (info /= psb_success_)goto 9996
    call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
    if(info.ne.0)print *,"matrix assembly failed"
    if(info.ne.0)goto 9996

    call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa)
    if(info.ne.0)print *,"psb_spsm failed"
    if(info.ne.0)goto 9996
    do i=1,2
      if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
      if(y(i) /= cy(i))info=-1
      if(y(i) /= cy(i))goto 9996
    enddo
9996 continue
    if(info /= psb_success_)res=res+1
    call psb_spfree(a,desc_a,info)
    if (info /= psb_success_)goto 9997
9997 continue
    if(info /= psb_success_)res=res+1
    call psb_cdfree(desc_a,info)
    if (info /= psb_success_)goto 9998
9998 continue
    if(info /= psb_success_)res=res+1
9999 continue
    if(info /= psb_success_)res=res+1
    if(res /= 0)print*,"on d matrix    2 x    2 blocked   1 x   1 ussv alpha=-3 beta= 0 incx=1 incy=1 trans=c is not ok"
    if(res == 0)print*,"on d matrix    2 x    2 blocked   1 x   1 ussv alpha=-3 beta= 0 incx=1 incy=1 trans=c is ok"
  end subroutine d_ussv_2_c_am3_bm0_ix1_iy1
  !
end module psb_d_mvsv_tester