DiagScale.F

#include "iadefines.h"
c**********************************************************************
#include "author.inc"
c*    $Id: DiagScale.F,v 1.14 1996/04/24 19:14:03 turner Exp $
c*
c*    Apply diagonal (Jacobi) scaling.
c*
c*    <PARAMETER LIST>
c*
c*     Input:
c*      ia - integer vector containing info about how "a" is stored
c*        NOTE: see description of ia below
c*      ja - index array
c*
c*     In/Out:
c*      b - source vector
c*      a - coefficient matrix
c*
c*     Output:
c*      status - return status
c*        -2  ==>  memory allocation failure
c*        -1  ==>  invalid argument(s)
c*         0  ==>  success
c*
#include "iadesc.inc"
c*
c*    <SUBROUTINES REQUIRED>
c*
c*     JT_DiagScale_Full - for full conventional format
c*     JT_DiagScale_ELL  - for ELLPACK-ITPACK format
c*     JT_DiagScale_COO  - for coordinate format
c*     JT_DiagScale_RSS  - for RSS format
c*     JT_DiagScale_CSS  - for CSS format
c*     JT_y_eq_yx
c*
#include "arrays-DiagScale.inc"
c*
#include "copyright.inc"
c**********************************************************************
      subroutine JT_DiagScale (b, a, ia, ja, status)
      implicit none
c
c ... Input:
      integer ia(_JT_no_of_storage_parameters_)
      integer ja(*)
c
c ... In/Out:
      real a(*)
#ifdef strict_f77
      real b(*)
#else
      real b(ia(_JT_nrows_))
#endif
c
c ... Output:
      integer status
c
c ... Local:
#include "declare-DiagScale.inc"
c
#include "allocate-DiagScale.inc"
c
      if (ia(_JT_storage_) .eq. _JT_storage_full_) then
       call JT_DiagScale_Full (ia(_JT_idim_), ia(_JT_nrows_), a, factor, status)
      elseif (ia(_JT_storage_) .eq. _JT_storage_ELL_) then
       call JT_DiagScale_ELL (ia(_JT_idim_), ia(_JT_nrows_), ia(_JT_maxnz_),
     &      a, factor, status)
      elseif (ia(_JT_storage_) .eq. _JT_storage_COO_) then
       call JT_DiagScale_COO (ia(_JT_nelem_), ia(_JT_nrows_), a, ja, factor, status)
      elseif (ia(_JT_storage_) .eq. _JT_storage_RSS_) then
       call JT_DiagScale_RSS (ia(_JT_nelem_), ia(_JT_nrows_), a, ja, factor, status)
      elseif (ia(_JT_storage_) .eq. _JT_storage_CSS_) then
       call JT_DiagScale_CSS (ia(_JT_nelem_), ia(_JT_nrows_), a, ja, factor, status)
      else
       status = -1
       goto 9999
      endif
c
c ... Scale source.
      call JT_y_eq_yx (ia(_JT_nrows_), factor, b, status)
c
 9999 continue
#include "deallocate-DiagScale.inc"
c
      return
      end