subroutine rscsb2 (array, prodx1, nrwblk, phi,
     *                   minblk, remblk, nparts, blaws)
c
      double precision array(nrwblk,2*nrwblk,1), phi(1),
     *                 prodx1(nrwblk,nrwblk,1), blaws(nrwblk,1)
      integer nrwblk, minblk, remblk, nparts
c    ***----------------------------------------------------------***
c    *   The following notation is used in the comments:            *
c    *                                                              *
c    *      V_k, W_k <=> array(1,1,k), array(1,nrwblk+1,k)          *
c    *           S_k <=> prodx1(1,1,k)                              *
c    *         phi_k <=> phi(k*nrwblk+1)                            *
c    *                                                              *
c    *   Since phi is overwritten with the solution,                *
c    *                                                              *
c    *      y_a <=> y_0      <=> phi_0  (<=> beta in rscsb3.f)      *
c    *              y_k      <=> phi_k,  k = 1, nbloks-1            *
c    *      y_b <=> y_nbloks <=> phi(nbloks*nrwblk+1)               *
c    *                                                              *
c    *   In addition, the affix '''/'' designates that the          *
c    *   solution vector was/is obtained at the third/second        *
c    *   level of the back-solve.                                   *
c    ***----------------------------------------------------------***
         integer kpart, base, basep, top
c    ***----------------------------------------------------------***
c    *      If there is only one partition, nothing needs to be     *
c    *      done at the second level of the back-solve.             *
c    ***----------------------------------------------------------***
         if (nparts .eq. 1) return
c    ***----------------------------------------------------------***
c    *      Back-solve starts at the first block-row of the         *
c    *      second-level system and proceeds downward sequentially  *
c    *      to the second-last block-row.                           *
c    ***----------------------------------------------------------***
         base = 0
         do 10 kpart = 1, nparts-1
            basep = base
            call partx(minblk,remblk,kpart,base,top)
c    ***----------------------------------------------------------***
c    *         y_base'' <- phi_base - S_kpart y_basep''             *
c    ***----------------------------------------------------------***
            call DGEMV('N',nrwblk,nrwblk,
     *                 -1.d0,prodx1(1,1,kpart),nrwblk,
     *                 phi(basep*nrwblk+1),1,1.d0,
     *                 phi(base*nrwblk+1),1)
c    ***----------------------------------------------------------***
c    *      The change of variable due to second-level rescaling    *
c    *      is now undone:  y_basep'' <- y_basep'' - y_base''       *
c    ***----------------------------------------------------------***
            call DAXPY(nrwblk,-1.d0,phi(base*nrwblk+1),1,
     *                              phi(basep*nrwblk+1),1)
  10     continue
      return
      end