LeftJustifyMatrix.F

c**********************************************************************
#include "author.inc"
c*    $Id: LeftJustifyMatrix.F,v 1.8 1995/07/30 17:57:25 turner Exp $
c*
c*    Left justifies elements in the coefficient matrix (all elements
c*    for which an element in ja has been set are left-justified, thus
c*    allowing elements themselves to be zero).
c*
c*    <PARAMETER LIST>
c*
c*     Input:
c*      idim  - leading dimension of a and ja
c*      n - number of unknowns
c*      maxnz - maximum number of elements in any row
c*
c*     In/Out:
c*      a - coefficient array
c*      ja - column indices of elements of a
c*
c*     Output:
c*      status - return status
c*        -2  ==>  memory allocation failure
c*        -1  ==>  invalid argument(s)
c*         0  ==>  success
c*
#include "arrays-LeftJustifyMatrix.inc"
c*
#include "copyright.inc"
c**********************************************************************
      subroutine JT_LeftJustifyMatrix (idim, n, maxnz, a, ja, status)
      implicit none
c
c ... Input:
      integer idim, maxnz, n
c
c ... In/Out:
      integer ja(idim,maxnz)
      real a(idim,maxnz)
c
c ... Output:
      integer status
c
c ... Local:
      integer i, icol, j
      real zero
#include "declare-LeftJustifyMatrix.inc"
c
      parameter (zero=0.0d0)
c
c ... Initialize return status.
      status = 0
c
c ... Check arguments.
      if (idim.le.0 .or. n.le.0 .or. maxnz.le.0 .or. n.gt.idim) then
       status = -1
       return
      endif
c
#include "allocate-LeftJustifyMatrix.inc"
c
      do i=1,n
       icol = 1
       do j=1,maxnz
        if ( ja(i,j) .ne. 0) then
         tmp(icol) = a(i,j)
         jtmp(icol) = ja(i,j)
         icol = icol + 1
        endif
       enddo
       do j=icol,maxnz
        tmp(j) = zero
        jtmp(j) = 0
       enddo
       do j=1,maxnz
        a(i,j) = tmp(j)
        ja(i,j) = jtmp(j)
       enddo
      enddo
c
 9999 continue
#include "deallocate-LeftJustifyMatrix.inc"
c
      return
      end