SolveUTriang.F

#include "iadefines.h"
c***********************************************************************
#include "author.inc"
c*    $Id: SolveUTriang.F,v 1.10 1996/04/24 19:14:37 turner Exp $
c*
c*    Solve upper triangular system.
c*
c*    <PARAMETER LIST>
c*
c*     Input:
c*      idiag - indicates whether diagonal is unity
c*        0 => general case
c*        non-zero => unit diagonal
c*      itrans - indicates whether to use transpose
c*        0 => no
c*        non-zero => use transpose
c*      a - matrix
c*      ia - integer vector containing info about how "a" is stored
c*        NOTE: see description of ia below
c*      ja - column map for matrix
c*
c*     In/Out:
c*      x - source vector on input, solution on output
c*
c*     Output:
c*      status - return status
c*        -4  ==>  breakdown
c*        -3  ==>  internal error
c*        -1  ==>  invalid argument(s)
c*         0  ==>  success
c*
#include "iadesc.inc"
c*
c*    <SUBROUTINES REQUIRED>
c*
c*     JT_SolveUTriang_ELL   for A stored in ELLPACK-ITPACK format
c*     JT_SolveUTriang_Full  for A stored in full conventional format
c*
#include "copyright.inc"
c***********************************************************************
      subroutine JT_SolveUTriang (idiag, itrans, a, ia, ja, x, status)
      implicit none
c
c ... Input:
      integer idiag, itrans
      integer ia(_JT_no_of_storage_parameters_), ja(*)
      real a(*)
c
c ... In/Out:
#ifdef strict_f77
      real x(*)
#else
      real x(ia(_JT_nrows_))
#endif
c
c ... Output:
      integer status
c
      if (ia(_JT_storage_) .eq. _JT_storage_full_) then
       call JT_SolveUTriang_Full (idiag, itrans, ia(_JT_idim_), ia(_JT_nrows_),
     &      a, x, status)
      else if (ia(_JT_storage_) .eq. _JT_storage_ELL_) then
       call JT_SolveUTriang_ELL (idiag, itrans, ia(_JT_idim_), ia(_JT_nrows_), 
     &      ia(_JT_maxnz_), a, ja, x, status)
      else
       status = -1
       return
      endif
c
      if (status .eq. -1) status = -3
c
      return
      end