B_eq_A_spec.F

c**********************************************************************
#include "author.inc"
c*    $Id: B_eq_A_spec.F,v 1.1 1995/11/14 02:19:34 turner Exp $
c*
c*    Copies a matrix stored in full conventional format.
c*
c*    <PARAMETER LIST>
c*
c*     Input:
c*      idim_a - leading dimension of a
c*      idim_b - leading dimension of b
c*      nrows - number of rows
c*      ncols - number of columns
c*      a - matrix to be copied
c*
c*     Output:
c*      b - destination matrix
c*      status - return status
c*
c*    <SUBROUTINES REQUIRED>
c*
c*     JT_y_eq_x
c*
#include "copyright.inc"
c**********************************************************************
      subroutine JT_B_eq_A_Full (idim_a, idim_b, nrows, ncols, a, b,
     &           status)
      implicit none
c
c ... Input:
      integer idim_a, idim_b, nrows, ncols
      real a(idim_a,ncols)
c
c ... Output:
      integer status
      real b(idim_b,ncols)
c
c ... Local:
      integer j
c
      do j=1,ncols
       call JT_y_eq_x (nrows, a(1,j), b(1,j), status)
      enddo
c
      return
      end
c**********************************************************************
#include "author.inc"
c*    $Id: B_eq_A_spec.F,v 1.1 1995/11/14 02:19:34 turner Exp $
c*
c*    Copies a matrix stored in ELL format.
c*
c*    <PARAMETER LIST>
c*
c*     Input:
c*      idim_a - leading dimension of a
c*      idim_b - leading dimension of b
c*      nrows - number of rows
c*      ncols - number of columns
c*      a - matrix to be copied
c*      ja - map array for a
c*
c*     Output:
c*      b - destination matrix
c*      jb - map array for b
c*      status - return status
c*
c*    <SUBROUTINES REQUIRED>
c*
c*     JT_B_eq_A_Full
c*
#include "copyright.inc"
c**********************************************************************
      subroutine JT_B_eq_A_ELL (idim_a, idim_b, nrows, ncols, a, ja,
     &           b, jb, status)
      implicit none
c
c ... Input:
      integer idim_a, idim_b, nrows, ncols
      integer ja(idim_a,ncols)
      real a(idim_a,ncols)
c
c ... Output:
      integer status
      integer jb(idim_b,ncols)
      real b(idim_b,ncols)
c
c ... Local:
      integer i, j
c
      call JT_B_eq_A_Full (idim_a, idim_b, nrows, ncols, a, b, status)
c
      do j=1,ncols
       do i=1,nrows
        jb(i,j) = ja(i,j)
       enddo
      enddo
c
      status = 0
      return
      end
c**********************************************************************
#include "author.inc"
c*    $Id: B_eq_A_spec.F,v 1.1 1995/11/14 02:19:34 turner Exp $
c*
c*    Copies a matrix stored in coordinate format.
c*
c*    <PARAMETER LIST>
c*
c*     Input:
c*      nelem_a - number of active elements in a and b
c*      a - matrix to be copied
c*      ja - map array for a
c*
c*     Output:
c*      b - destination matrix
c*      jb - map array for b
c*      status - return status
c*
c*    <SUBROUTINES REQUIRED>
c*
c*     JT_y_eq_x
c*     JT_iy_eq_ix
c*
#include "copyright.inc"
c**********************************************************************
      subroutine JT_B_eq_A_COO (nelem, a, ja, b, jb, status)
      implicit none
c
c ... Input:
      integer nelem
      integer ja(2*nelem)
      real a(nelem)
c
c ... Output:
      integer status
      integer jb(2*nelem)
      real b(nelem)
c
      call JT_y_eq_x (nelem, a, b, status)
      call JT_iy_eq_ix (2*nelem, ja, jb, status)
c
      status = 0
      return
      end
c**********************************************************************
#include "author.inc"
c*    $Id: B_eq_A_spec.F,v 1.1 1995/11/14 02:19:34 turner Exp $
c*
c*    Copies a matrix stored in RSS or CSS format.
c*
c*    <PARAMETER LIST>
c*
c*     Input:
c*      nelem - number of active elements in a and b
c*      a - matrix to be copied
c*      ja - map array for a
c*
c*     Output:
c*      b - destination matrix
c*      jb - map array for b
c*      status - return status
c*
c*    <SUBROUTINES REQUIRED>
c*
c*     JT_y_eq_x
c*     JT_iy_eq_ix
c*
#include "copyright.inc"
c**********************************************************************
      subroutine JT_B_eq_A_xSS (nelem, a, ja, b, jb, status)
      implicit none
c
c ... Input:
      integer nelem
      integer ja(nelem)
      real a(nelem)
c
c ... Output:
      integer status
      integer jb(nelem)
      real b(nelem)
c
      call JT_y_eq_x (nelem, a, b, status)
      call JT_iy_eq_ix (nelem, ja, jb, status)
c
      status = 0
      return
      end