diagB_eq_diagA.F

#include "iadefines.h"
c**********************************************************************
#include "author.inc"
c*    $Id: diagB_eq_diagA.F,v 1.7 1996/04/24 19:15:10 turner Exp $
c*
c*    Copies the diagonal of one matrix into the diagonal of another.
c*
c*    <PARAMETER LIST>
c*
c*     Input:
c*      a - matrix to be copied
c*      ia - integer vector containing info about how "a" is stored
c*        NOTE: see description of ia below
c*      ja - column index array for a
c*
c*     Output:
c*      b - destination matrix
c*      ib - integer vector containing info about how "b" is stored
c*        NOTE: see description of ia below
c*      jb - column index array for b
c*      status - return status
c*        -1  ==>  invalid argument(s)
c*         0  ==>  success
c*
c*    <SUBROUTINES REQUIRED>
c*
c*     JT_diagB_eq_diagA_Full
c*
#include "iadesc.inc"
c*
#include "copyright.inc"
c**********************************************************************
      subroutine JT_diagB_eq_diagA (a, ia, ja, b, ib, jb, status)
      implicit none
c
c ... Input:
      integer ia(_JT_no_of_storage_parameters_), ja(*)
      real a(*)
c
c ... Output:
      integer status
      integer ib(_JT_no_of_storage_parameters_), jb(*)
      real b(*)
c
      if (ia(_JT_storage_) .eq. _JT_storage_full_) then
       call JT_diagB_eq_diagA_Full (ia(_JT_idim_), ib(_JT_idim_),
     &      ia(_JT_nrows_), a, b, status)
      elseif (ia(_JT_storage_).eq._JT_storage_ELL_ .or.
     &        ia(_JT_storage_).eq._JT_storage_COO_ .or.
     &        ia(_JT_storage_).eq._JT_storage_RSS_ .or.
     &        ia(_JT_storage_).eq._JT_storage_CSS_) then
       call JT_y_eq_x (ia(_JT_nrows_), a, b, status)
      else
       status = -1
      endif
c
      return

      end
c**********************************************************************
#include "author.inc"
c*
c*    Copies the inverse of the diagonal of one matrix into the
c*    diagonal of another.
c*
c*    <PARAMETER LIST>
c*
c*     Input:
c*      a - matrix to be copied
c*      ia - integer vector containing info about how "a" is stored
c*        NOTE: see description of ia below
c*      ja - map array for a
c*
c*     Output:
c*      b - destination matrix
c*      ib - integer vector containing info about how "b" is stored
c*        NOTE: see description of ia below
c*      jb - map array for b
c*      status - return status
c*        -1  ==>  invalid argument(s)
c*         0  ==>  success
c*
c*    <SUBROUTINES REQUIRED>
c*
c*     JT_diagB_eq_invdiagA_Full
c*
#include "iadesc.inc"
c*
#include "copyright.inc"
c**********************************************************************
      subroutine JT_diagB_eq_invdiagA (a, ia, ja, b, ib, jb, status)
      implicit none
c
c ... Input:
      integer ia(_JT_no_of_storage_parameters_), ja(*)
      real a(*)
c
c ... Output:
      integer status
      integer ib(_JT_no_of_storage_parameters_), jb(*)
      real b(*)
c
c ... Local:
      real one
c
      parameter (one=1.0d0)
c
      if (ia(_JT_storage_) .eq. _JT_storage_full_) then
       call JT_diagB_eq_invdiagA_Full (ia(_JT_idim_), ib(_JT_idim_), ia(_JT_nrows_), a, b,
     &      status)
      elseif (ia(_JT_storage_).eq._JT_storage_ELL_ .or.
     &        ia(_JT_storage_).eq._JT_storage_COO_ .or.
     &        ia(_JT_storage_).eq._JT_storage_RSS_ .or.
     &        ia(_JT_storage_).eq._JT_storage_CSS_) then
       call JT_y_eq_s_div_x (ia(_JT_nrows_), one, a, b, status)
      else
       status = -1
      endif
c
      return

      end