MatrixNorm.F

#include "iadefines.h"
c**********************************************************************
#include "author.inc"
c*    $Id: MatrixNorm.F,v 1.8 1996/04/24 19:15:08 turner Exp $
c*
c*    Computes the norm of a matrix A.
c*
c*    WARNING: Note that JT_MatrixNorm *must* be declared real in
c*             routines that use it.
c*
c*    <PARAMETER LIST>
c*     Input:
c*      norm - determines which vector norm to use
c*         0  ==>  infinity norm
c*         1  ==>  1-norm
c*         2  ==>  Frobenius norm
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*                                        n
c*                                       ---
c*                                       \  
c*           infinity norm  ==>    max   /   | a  |
c*                               1<=i<=m ---    ij
c*                                       j=1
c*                                 m 
c*                                ---
c*                                \  
c*           1-norm  ==>    max   /   | a  |
c*                        1<=j<=n ---    ij
c*                                i=1
c*                                      m   n
c*                                     --- ---
c*                                     \   \    2
c*           Frobenius norm  ==>  sqrt /   /   a
c*                                     --- ---  ij
c*                                     i=1 j=1
c*
#include "iadesc.inc"
c*
c*     Output:
c*      JT_MatrixNorm - norm of A
c*      status - return status
c*        -3  ==>  internal error
c*        -2  ==>  memory allocation failure
c*        -1  ==>  invalid argument(s)
c*         0  ==>  success
c*
c*    <FUNCTIONS REQUIRED>
c*
c*     JT_MatrixNorm_ELL   for A stored in ELLPACK-ITPACK format
c*     JT_MatrixNorm_Full  for A stored in full conventional format
c*     JT_MatrixNorm_COO   for A stored in coordinate format
c*     JT_MatrixNorm_RSS   for A stored in RSS format
c*     JT_MatrixNorm_CSS   for A stored in CSS format
c*
#include "copyright.inc"
c**********************************************************************
      real function JT_MatrixNorm(norm, a, ia, ja, status)
      implicit none
c
c ... Input:
      integer norm
      integer ia(_JT_no_of_storage_parameters_), ja(*)
      real a(*)
c
c ... Output:
      integer status
c
c ... Local:
      real zero
      real JT_MatrixNorm_ELL,
     &     JT_MatrixNorm_Full,
     &     JT_MatrixNorm_COO,
     &     JT_MatrixNorm_RSS,
     &     JT_MatrixNorm_CSS
c
      parameter (zero=0.0d0)
c
c ... Initialize function result.
      JT_MatrixNorm = zero
c
      if (ia(_JT_storage_) .eq. _JT_storage_full_) then
       JT_MatrixNorm = JT_MatrixNorm_Full(norm, ia(_JT_idim_),
     &                 ia(_JT_nrows_), ia(_JT_nrows_), a, status)
      elseif (ia(_JT_storage_) .eq. _JT_storage_ELL_) then
       JT_MatrixNorm = JT_MatrixNorm_ELL(norm, ia(_JT_idim_),
     &                 ia(_JT_nrows_), ia(_JT_maxnz_), a, ja, status)
      elseif (ia(_JT_storage_) .eq. _JT_storage_COO_) then
       JT_MatrixNorm = JT_MatrixNorm_COO(norm, ia(_JT_nelem_),
     &                 ia(_JT_nrows_), a, ja, status)
      elseif (ia(_JT_storage_) .eq. _JT_storage_RSS_) then
       JT_MatrixNorm = JT_MatrixNorm_RSS(norm, ia(_JT_nelem_),
     &                 ia(_JT_nrows_), a, ja, status)
      elseif (ia(_JT_storage_) .eq. _JT_storage_CSS_) then
       JT_MatrixNorm = JT_MatrixNorm_CSS(norm, ia(_JT_nelem_),
     &                 ia(_JT_nrows_), a, ja, status)
      else
       status = -1
       return
      endif
c
      if (status .eq. -1) status = -3
c
      return
      end