SOR.F

#include "iadefines.h"
c**********************************************************************
#include "author.inc"
c*    $Id: SOR.F,v 1.4 1996/04/24 19:34:46 turner Exp $
c*
c*    Perform one SOR iteration.
c*
c*    <PARAMETER LIST>
c*
c*     Input:
c*      imeth - determines whether or not to perform SSOR
c*      omega - relaxation parameter
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*      b - source vector
c*
c*     In/Out:
c*      x - solution vector
c*
c*     Output:
c*      status - return status
c*        -1  ==>  invalid argument(s)
c*         0  ==>  success
c*
c*    <SUBROUTINES REQUIRED>
c*
c*     JT_SOR_ELL
c*     JT_SOR_Full
c*     JT_SOR_COO
c*     JT_SOR_RSS
c*     JT_SOR_CSS
c*
#include "iadesc.inc"
c*
#include "copyright.inc"
c**********************************************************************
      subroutine JT_SOR (imeth, omega, b, a, ia, ja, x, status)
      implicit none
c
c ... Input:
      integer imeth, ia(_JT_no_of_storage_parameters_), ja(*)
      real omega
      real a(*), b(*)
c
c ... In/Out:
      real x(*)
c
c ... Output:
      integer status
c
      if (ia(_JT_storage_) .eq. _JT_storage_full_) then    ! Conventional full storage
       call JT_SOR_Full (imeth, ia(_JT_idim_), ia(_JT_nrows_), omega,
     &      b, a, x, status)
      elseif (ia(_JT_storage_) .eq. _JT_storage_ELL_) then ! ELLPACK-ITPACK storage
       call JT_SOR_ELL (imeth, ia(_JT_idim_), ia(_JT_nrows_), ia(_JT_maxnz_), omega, 
     &      b, a, ja, x, status)
      elseif (ia(_JT_storage_) .eq. _JT_storage_COO_) then ! coordinate storage
       call JT_SOR_COO (imeth, ia(_JT_nelem_), ia(_JT_nrows_), omega, 
     &      b, a, ja, x, status)
      elseif (ia(_JT_storage_) .eq. _JT_storage_RSS_) then ! RSS storage
       call JT_SOR_RSS (imeth, ia(_JT_nelem_), ia(_JT_nrows_), omega, 
     &      b, a, ja, x, status)
      elseif (ia(_JT_storage_) .eq. _JT_storage_CSS_) then ! CSS storage
       call JT_SOR_CSS (imeth, ia(_JT_nelem_), ia(_JT_nrows_), omega, 
     &      b, a, ja, x, status)
      else
       status = -1
      endif
c
      return
      end