      subroutine jki_block(m,n,a,lda,ipiv,info,nb)
c
c     Blocked jki-GAXPY method with Level 3 BLAS
c     Northeast Parallel Architecture Center,Syracuse University.
c     July 1. 1992
c     Gregor von Laszewski, A. Gaber Mohamed 
c     .. scalar arguments ..
      integer            info,lda,m,n
c     ..
c     .. array arguments ..
      integer            ipiv(*)
      real   a(lda,*)
c     ..
c
c  purpose
c  =======
c
c  jki_block computes an LU-factorization of a general m-by-n matrix a
c  using partial pivoting with row interchanges. At the kth step of
c  the elemination,a block column of both matrices U and L is
c  comuted.
c
c  the factorization has the form
c     A = P * L * U
c  where P is a permutation matrix,L is lower triangular with unit
c  diagonal elements (lower trapezoidal if m > n),and U is upper
c  triangular (upper trapezoidal if m < n).
c
c
c  arguments
c  =========
c
c  m       (input) integer
c          the number of rows of the matrix a.  m >= 0.
c
c  n       (input) integer
c          the number of columns of the matrix a.  n >= 0.
c
c  a       (input/output) real array,dimension (lda,n)
c          on entry,the m x n matrix to be factored.
c          on exit,the factors l and u; the unit diagonal elements of l
c          are not stored.
c
c  lda     (input) integer
c          the leading dimension of the array a.  lda >= max(1,m).
c
c  ipiv    (output) integer array,dimension (min(m,n))
c          the pivot indices.  row i of the matrix was interchanged with
c          row ipiv(i).
c
c  info    (output) integer
c          = 0: successful exit
c          < 0: if info = -k,the k-th argument had an illegal value
c          > 0: if info = k,u(k,k) is exactly zero. the factorization
c               has been completed,but the factor u is exactly
c               singular,and division by zero will occur if it is used
c               to solve a system of equations or to compute the inverse
c               of a.
c
c  =====================================================================
c
c     .. parameters ..
      real   one
      parameter          (one = 1.0d+0)
c     ..
c     .. local scalars ..
      integer            i,k,kb,nb
c     ..
c     .. external subroutines ..
      external           dgemm,dgetf2,dlaswp,dtrsm,xerbla
c     ..
c     .. intrinsic functions ..
      intrinsic          max,min
c     ..
c     .. executable statements ..
c
c     test the input parameters.
c
      info = 0
      if(m.lt.0) then
         info = -1
      else if(n.lt.0) then
         info = -2
      else if(lda.lt.max(1,m)) then
         info = -4
      end if
      if(info.ne.0) then
         call xerbla('jki_block',-info)
         return
      end if
c
c     quick return if possible.
c
      if(m.eq.0 .or. n.eq.0)
     $   return
c
      if(nb.eq.1) then
c         call jik_noblock(m,n,a,lda,ipiv,info)
          call sgetf2 (m,n,A,lda,piv,info)
      else
c       cccccccccccccccccc MAIN LOOP  cccccccccccccccccccccccccccccccccccccccc
c
         do 20 j = 1,min(m,n),nb
            jb = min(min(m,n)-j+1,nb)
c
c           Apply previous interchanges to current block. 
c

            call slaswp(jb,a(1,j),lda,1,j-1,ipiv,1)	

c
c           Apply previous transformations to current block of U.
c
 	    do 10 k=1,j-1,nb
               kb= min(nb,j-k)

               call strsm('left','lower','no transpose','unit',kb,
     $                     jb,one,a(k,k),lda,a(k,j),lda)

               call sgemm('no transpose','no transpose',j-k-kb,jb,
     $                     kb,-one,a(k+kb,k),lda,a(k,j),lda,
     $                     one,a(k+kb,j),lda)
 10	    continue

c           Update diagonal and subdiagonal blocks

            call sgemm('no transpose','no transpose',m-j+1,jb,j-1,
     $                  -one,a(j,1),lda,a(1,j),lda,one,
     $                  a(j,j),lda)
c
c           factorize diagonal and subdiagonal blocks 
c
            call sgetf2 (m-j+1,jb,a(j,j),lda,ipiv(j),info)
c            call jik_noblock(m-j+1,jb,a(j,j),lda,ipiv(j),info)
c
c           update pivot indices and apply the interchanges to the
c           columns on either side of the current block.
c
            do 15 i = j,min(m,j+jb-1)
               ipiv(i) = j - 1 + ipiv(i)
   15       continue
            call slaswp(j-1,a,lda,j,j+jb-1,ipiv,1)
c
            if(info.ne.0) go to 30
c
   20    continue
      end if
      return
c
   30 continue
      info = info + k - 1
      return
c
c     end of jki_block
c    
      end

