subroutine rscfa (lftblk, array, nrwblk, nbloks, rgtblk,
     *                  pivot, iflag, nparts, work)
c
      double precision lftblk(1), array(1), rgtblk(1), work(1)
      integer nrwblk, nbloks, pivot(1), iflag, nparts
c    ***----------------------------------------------------------***
c    *   This subroutine factors the ABD matrix defined in arrays   *
c    *   lftblk, array, and rgtblk using a variant of the parallel  *
c    *   Rescaling algorithm.  On return, lftblk, array, rgtblk,    *
c    *   work, and pivot contain the decomposition of the matrix    *
c    *   and pivoting strategy used.  See comments in subroutine    *
c    *   'rscale' for further details.                              *
c    ***----------------------------------------------------------***
         integer nsquar, wk1, wk2, wk3, wk4, minblk, remblk
c
         iflag = 0
c    ***----------------------------------------------------------***
c    *      Use non-partitioned Rescaling if requested number       *
c    *      of partitions would result in fewer than 2 blocks       *
c    *      per partition.                                          *
c    ***----------------------------------------------------------***
         if (nbloks .lt. 2*nparts) then
            nparts = 1
         endif
c    ***----------------------------------------------------------***
c    *      Work-space allocation:                                  *
c    *         right blocks             -   work(1)..work(wk2-1)    *
c    *         1st-level product blocks - work(wk2)..work(wk3-1)    *
c    *         2nd-level product block  - work(wk3)..work(wk4-1)    *
c    *         local storage for BLAS   - work(wk4)..end            *
c    *                                                              *
c    *      Total requirement:  nbloks*[nrwblkxnrwblk]              *
c    *                        + nparts*[nrwblkxnrwblk]              *
c    *                        +        [nrwblkxnrwblk]              *
c    *                        + nparts*[nrwblkxnrwblk]              *
c    ***----------------------------------------------------------***
         nsquar = nrwblk**2
         wk1 = 1
         wk2 = wk1 + nbloks*nsquar
         wk3 = wk2 + nparts*nsquar
         wk4 = wk3 + nsquar
c    ***----------------------------------------------------------***
c    *      Calculate minimum number of blocks per partition        *
c    *      Remaining blocks are distributed evenly among the       *
c    *      first partitions.                                       *
c    ***----------------------------------------------------------***
         minblk = nbloks/nparts
         remblk = nbloks - minblk*nparts
c    ***----------------------------------------------------------***
c    *      Three level factorization.  The factorization is        *
c    *      aborted immediatley if singularity is detected.         *
c    ***----------------------------------------------------------***
         call rscf1(array,work(wk1),work(wk2),nrwblk,pivot,iflag,
     *              minblk,remblk,nparts,work(wk4))
         if (iflag .eq. 0) then
            call rscf2(array,work(wk1),work(wk2),work(wk3),nrwblk,
     *                 pivot,iflag,minblk,remblk,nparts,work(wk4))
            if (iflag .eq. 0) then
               call rscf3(lftblk,array,work(wk1),work(wk2),work(wk3),
     *             nrwblk,nbloks,rgtblk,pivot,iflag,nparts,work(wk4))
            endif
         endif
c    ***----------------------------------------------------------***
c    *      Set iflag to -1 if exact singularity was detected.      *
c    ***----------------------------------------------------------***
         if (iflag .ne. 0) then
            iflag = -1
         endif
      return
      end