RowScale_spec.F

c**********************************************************************
#include "author.inc"
c*    $Id: RowScale_spec.F,v 1.1 1995/11/14 02:20:07 turner Exp $
c*
c*    Subroutine to row-scale a linear system.
c*
c*    <PARAMETER LIST>
c*
c*     Input:
c*      idim - leading dimension of a
c*      nrows - number of rows in a
c*      ncols - number of columns in a
c*
c*     In/Out:
c*      a - coefficient matrix
c*
c*     Output:
c*      factor - vector of scaling factors
c*      status - return status
c*
c*    <SUBROUTINES REQUIRED>
c*
c*     JT_FillVectorFloat
c*     JT_y_eq_yx
c*
#include "copyright.inc"
c**********************************************************************
      subroutine JT_RowScale_Row (idim, nrows, ncols, a, factor,
     &           status)
      implicit none
c
c ... Input:
      integer idim, nrows, ncols
c
c ... In/Out:
      real a(idim,ncols)
c
c ... Output:
      integer status
      real factor(nrows)
c
c ... Local:
      integer i, j
      real zero, one
c
      parameter (zero=0.0d0, one=1.0d0)
c
c ... Find max element in each row.
      call JT_FillVectorFloat (nrows, zero, factor, status)
      do j=1,ncols
       do i=1,nrows
        factor(i) = MAX( factor(i) , ABS(a(i,j)) )
       enddo
      enddo
      do i=1,nrows
       factor(i) = one / factor(i)
      enddo
c
c ... Scale coefficient.
      do j=1,ncols
       call JT_y_eq_yx (nrows, factor, a(1,j), status)
      enddo
c
      return
      end
c**********************************************************************
#include "author.inc"
c*    $Id: RowScale_spec.F,v 1.1 1995/11/14 02:20:07 turner Exp $
c*
c*    Subroutine to row-scale a linear system stored in coordinate
c*    format.
c*
c*    <PARAMETER LIST>
c*
c*     Input:
c*      nelem - number of active elements in a
c*      nrows - number of rows in a
c*      ja - index array
c*
c*     In/Out:
c*      a - coefficient matrix
c*
c*     Output:
c*      factor - vector of scaling factors
c*      status - return status
c*
c*    <SUBROUTINES REQUIRED>
c*
c*     JT_FillVectorFloat
c*     JT_y_eq_yx
c*
#include "copyright.inc"
c**********************************************************************
      subroutine JT_RowScale_COO (nelem, nrows, a, ja, factor, status)
      implicit none
c
c ... Input:
      integer nelem, nrows
      integer ja(2*nelem)
c
c ... In/Out:
      real a(nelem)
c
c ... Output:
      integer status
      real factor(nrows)
c
c ... Local:
      integer i
      real zero, one
c
      parameter (zero=0.0d0, one=1.0d0)
c
c ... Find max element in each row.
      call JT_FillVectorFloat (nrows, zero, factor, status)
      do i=1,nelem
       factor(ja(i)) = MAX( factor(ja(i)) , ABS(a(i)) )
      enddo
      do i=1,nrows
       factor(i) = one / factor(i)
      enddo
c
c ... Scale coefficient.
      do i=1,nelem
       a(i) = factor(ja(i))*a(i)
      enddo
c
      return
      end
c**********************************************************************
#include "author.inc"
c*    $Id: RowScale_spec.F,v 1.1 1995/11/14 02:20:07 turner Exp $
c*
c*    Subroutine to row-scale a linear system stored in RSS format.
c*
c*    <PARAMETER LIST>
c*
c*     Input:
c*      nelem - number of active elements in a
c*      nrows - number of rows in a
c*      ja - index array
c*
c*     In/Out:
c*      a - coefficient matrix
c*
c*     Output:
c*      factor - vector of scaling factors
c*      status - return status
c*
c*    <SUBROUTINES REQUIRED>
c*
c*     JT_FillVectorFloat
c*     JT_y_eq_yx
c*
#include "copyright.inc"
c**********************************************************************
      subroutine JT_RowScale_RSS (nelem, nrows, a, ja, factor, status)
      implicit none
c
c ... Input:
      integer nelem, nrows
      integer ja(nelem)
c
c ... In/Out:
      real a(nelem)
c
c ... Output:
      integer status
      real factor(nrows)
c
c ... Local:
      integer i, ij
      real zero, one
c
      parameter (zero=0.0d0, one=1.0d0)
c
c ... Find max element in each row.
      call JT_FillVectorFloat (nrows, zero, factor, status)
      do ij=1,nelem
       i = (ja(ij) - 1)/nrows + 1
       factor(i) = MAX( factor(i) , ABS(a(ij)) )
      enddo
      do i=1,nrows
       factor(i) = one / factor(i)
      enddo
c
c ... Scale coefficient.
      do ij=1,nelem
       i = (ja(ij) - 1)/nrows + 1
       a(ij) = factor(i)*a(ij)
      enddo
c
      return
      end
c**********************************************************************
#include "author.inc"
c*    $Id: RowScale_spec.F,v 1.1 1995/11/14 02:20:07 turner Exp $
c*
c*    Subroutine to row-scale a linear system stored in CSS format.
c*
c*    <PARAMETER LIST>
c*
c*     Input:
c*      nelem - number of active elements in a
c*      nrows - number of rows in a
c*      ja - index array
c*
c*     In/Out:
c*      a - coefficient matrix
c*
c*     Output:
c*      factor - vector of scaling factors
c*      status - return status
c*
c*    <SUBROUTINES REQUIRED>
c*
c*     JT_FillVectorFloat
c*     JT_y_eq_yx
c*
#include "copyright.inc"
c**********************************************************************
      subroutine JT_RowScale_CSS (nelem, nrows, a, ja, factor, status)
      implicit none
c
c ... Input:
      integer nelem, nrows
      integer ja(nelem)
c
c ... In/Out:
      real a(nelem)
c
c ... Output:
      integer status
      real factor(nrows)
c
c ... Local:
      integer i, j, ij
      real zero, one
c
      parameter (zero=0.0d0, one=1.0d0)
c
c ... Find max element in each row.
      call JT_FillVectorFloat (nrows, zero, factor, status)
      do ij=1,nelem
       j = (ja(ij) - 1)/nrows + 1
       i = ja(ij) - (j-1)*nrows
       factor(i) = MAX( factor(i) , ABS(a(ij)) )
      enddo
      do i=1,nrows
       factor(i) = one / factor(i)
      enddo
c
c ... Scale coefficient.
      do ij=1,nelem
       j = (ja(ij) - 1)/nrows + 1
       i = ja(ij) - (j-1)*nrows
       a(ij) = factor(i)*a(ij)
      enddo
c
      return
      end