WriteSystem.F

#include "iadefines.h"
c**********************************************************************
#include "author.inc"
c*    $Id: WriteSystem.F,v 1.13 1996/04/24 19:14:13 turner Exp $
c*
c*    Writes out entire linear system, Ax = b.
c*
c*    <PARAMETER LIST>
c*
c*     Input:
c*      lu - logical unit to which to write
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*      x - unknown vector
c*      b - source vector
c*      title - character description
c*
c*     Output:
c*      status - return status
c*        -1  ==>  invalid argument(s)
c*         0  ==>  success
c*
#include "iadesc.inc"
c*
c*    <SUBROUTINES REQUIRED>
c*
c*     JT_FlushUnit
c*     JT_WriteMatrixInt
c*     JT_WriteMatrix_COO
c*     JT_WriteSystemFloat
c*     JT_WriteVectorFloat
c*
#include "copyright.inc"
c**********************************************************************
      subroutine JT_WriteSystem (lu, a, ia, ja, x, b, title, status)
      implicit none
c
c ... Input:
      integer lu
      integer ia(_JT_no_of_storage_parameters_), ja(*)
      real a(*)
#ifdef strict_f77
      real b(*), x(*)
#else
      real b(ia(_JT_nrows_)), x(ia(_JT_nrows_))
#endif
      character*(*) title
c
c ... Output:
      integer status
c
      if (ia(_JT_storage_) .eq. _JT_storage_full_) then
       call JT_WriteSystemFloat 
     &      (lu, ia(_JT_idim_), ia(_JT_nrows_), ia(_JT_nrows_), a, x, b, title, status)
      elseif (ia(_JT_storage_) .eq. _JT_storage_ELL_) then
       call JT_WriteSystemFloat 
     &      (lu, ia(_JT_idim_), ia(_JT_nrows_), ia(_JT_maxnz_), a, x, b, title, status)
       call JT_WriteMatrixInt 
     &      (lu, ia(_JT_idim_), ia(_JT_nrows_), ia(_JT_maxnz_), ja,
     &      'Column map for the above matrix:', status)
      elseif (ia(_JT_storage_) .eq. _JT_storage_COO_) then
       write(lu,*)
       write(lu,*) title
       write(lu,*)
       call JT_WriteMatrix_COO (lu, ia(_JT_nelem_), a, ja,
     &     'Coefficient:', status)
       call JT_WriteVectorFloat (lu, ia(_JT_nrows_), x, 'Unknowns:', status)
       call JT_WriteVectorFloat (lu, ia(_JT_nrows_), b, 'Source:', status)
      elseif (ia(_JT_storage_) .eq. _JT_storage_RSS_) then
       write(lu,*)
       write(lu,*) title
       write(lu,*)
       call JT_WriteMatrix_RSS (lu, ia(_JT_nelem_), ia(_JT_nrows_), a, ja,
     &     'Coefficient:', status)
       call JT_WriteVectorFloat (lu, ia(_JT_nrows_), x, 'Unknowns:', status)
       call JT_WriteVectorFloat (lu, ia(_JT_nrows_), b, 'Source:', status)
      elseif (ia(_JT_storage_) .eq. _JT_storage_CSS_) then
       write(lu,*)
       write(lu,*) title
       write(lu,*)
       call JT_WriteMatrix_CSS (lu, ia(_JT_nelem_), ia(_JT_nrows_), a, ja,
     &     'Coefficient:', status)
       call JT_WriteVectorFloat (lu, ia(_JT_nrows_), x, 'Unknowns:', status)
       call JT_WriteVectorFloat (lu, ia(_JT_nrows_), b, 'Source:', status)
      else
       status = -1
       goto 9999
      endif
c
      call JT_FlushUnit (lu, status)
c
 9999 continue
      return
      end