Sources Esope | Cast3M

dmomv
C DMOMV     SOURCE    GOUNAND   05/02/16    21:15:19     5029
      SUBROUTINE DMOMV ( TRANS, N, ALPHA, NNZ, ROWPTR, COLIND, VAL,
     $     X, BETA, Y )
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
***********************************************************************
C NOM         : DMOMV
C DESCRIPTION :
C  DMOMV is a modified (16/2/98), reduced,
C  version of DGEMV as defined in BLAS 2.
C
C  It performs one of the matrix-vector operations
C
C     y := alpha*A*x + beta*y,   or   y := alpha*A'*x + beta*y,
C
C  where alpha and beta are scalars, x and y are vectors
C  A is an n by n (square) matrix stored in Morse format
C  (also known as Compressed Row Storage (CRS)).
C
C LANGAGE     : ESOPE
C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF)
C               mél : gounand@semt2.smts.cea.fr
C REFERENCE (bibtex-like) :
C  @BOOK{templates,
C        AUTHOR={R.Barrett, M.Berry, T.F.Chan, J.Demmel, J.Donato,
C                J.Dongarra, V.Eijkhout, R.Pozo, C.Romine,
C                H. Van der Vorst},
C        TITLE={Templates for the Solution of Linear Systems :
C               Building Blocks for Iterative Methods},
C        PUBLISHER={SIAM}, YEAR={1994}, ADDRESS={Philadelphia,PA} }
C  -> URL : http://www.netlib.org/templates/Templates.html
C***********************************************************************
C APPELES : -
C***********************************************************************
C ENTREES            : TRANS, N, ALPHA,
C                      NNZ, ROWPTR, COLIND, VAL,
C                      X, BETA
C ENTREES/SORTIES    : Y
C SORTIES            : -
C CODE RETOUR (IRET) : -
C  TRANS  - CHARACTER*1.
C           On entry, TRANS specifies the operation to be performed as
C           follows:
C              TRANS = 'N' or 'n'   y := alpha*A*x + beta*y.
C              TRANS = 'T' or 't'   y := alpha*A'*x + beta*y.
C              TRANS = 'C' or 'c'   y := alpha*A'*x + beta*y.
C  Note : working with TRANS = 'T' might be slower due to storage format
C  If speed is more important than memory consumption, storing the
C      transpose matrix before calling DMOMV might help
C
C  N      - INTEGER.
C           On entry, N specifies the number of columns and rows
C           of the matrix A.
C           N must be at least zero.
C
C  ALPHA  - REAL*8.
C           On entry, ALPHA specifies the scalar alpha.
C
C  NNZ    : nombre de valeurs non nulles de la matrice Morse
C  ROWPTR, COLIND, VAL : pointeur de ligne, index de colonne
C                        et valeurs de la matrice Morse
C
C  X      - REAL*8 array of DIMENSION N
C
C  BETA   - REAL*8.
C           On entry, BETA specifies the scalar beta. When BETA is
C           supplied as zero then Y need not be set on input.
C
C  Y      - REAL*8 array of DIMENSION N
C           Before entry with BETA non-zero, the array Y
C           must contain the vector y. On exit, Y is overwritten by the
C           updated vector y.
C
C***********************************************************************
C VERSION    : v1, 16/02/98, version initiale
C HISTORIQUE : v1, 16/02/98, création
C HISTORIQUE :
C HISTORIQUE :
C***********************************************************************
C Prière de PRENDRE LE TEMPS de compléter les commentaires
C en cas de modification de ce sous-programme afin de faciliter
C la maintenance !
C***********************************************************************
*     .. Scalar Arguments ..
      REAL*8             ALPHA, BETA
      INTEGER            N, NNZ
      CHARACTER*1        TRANS
*     .. Array Arguments ..
*     .. Morse Matrix
      INTEGER ROWPTR( N+1 )
      INTEGER COLIND( NNZ )
      REAL*8  VAL( NNZ )
*     .. Vectors
      REAL*8     X( N ), Y( N )
*     ..
*  Level 2 Blas routine.
*
*  -- Written on 22-October-1986.
*     Jack Dongarra, Argonne National Lab.
*     Jeremy Du Croz, Nag Central Office.
*     Sven Hammarling, Nag Central Office.
*     Richard Hanson, Sandia National Labs.
*  -- Modified on 16-February-1998
*
 
-INC PPARAM
-INC CCOPTIO
*
*     .. Parameters ..
      REAL*8             ONE         , ZERO
      PARAMETER        ( ONE = 1.0D+0, ZERO = 0.0D+0 )
*     .. Local Scalars ..
      REAL*8             TEMP
      INTEGER            I, J
*     .. External Functions ..
      LOGICAL            LSAME
      EXTERNAL           LSAME
*     ..
*     .. Executable Statements ..
*
*     Test the input parameters.
*
      IF     ( .NOT.LSAME( TRANS, 'N' ).AND.
     $         .NOT.LSAME( TRANS, 'T' ).AND.
     $         .NOT.LSAME( TRANS, 'C' )      )THEN
         GOTO 9999
      ELSE IF( N.LE.0 )THEN
         GOTO 9998
      END IF
*
*     Quick return if possible.
*
      IF( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) )
     $     RETURN
*
*     Start the operations. In this version the elements of A are
*     accessed sequentially with one pass through A.
*
*     First form  y := beta*y.
*
      IF( BETA.NE.ONE )THEN
         IF( BETA.EQ.ZERO )THEN
            DO 10, I = 1, N
               Y( I ) = ZERO
 10         CONTINUE
         ELSE
            DO 20, I = 1, N
               Y( I ) = BETA*Y( I )
 20         CONTINUE
         END IF
      END IF
      IF( ALPHA.EQ.ZERO )
     $     RETURN
      IF( LSAME( TRANS, 'N' ) )THEN
*
*        Form  y := alpha*A*x + y.
*
         DO 60, I = 1, N
            DO 50, J = ROWPTR( I ), (ROWPTR( I+1 ) - 1)
*!!!               IF ( X( COLIND( J )).NE.ZERO ) THEN
                  Y( I ) = Y( I ) + (ALPHA * VAL( J ) * X( COLIND( J )))
*!!!               ENDIF
 50         CONTINUE
 60      CONTINUE
      ELSE
*
*        Form  y := alpha*A'*x + y.
*
         DO 100, J = 1, N
            IF ( X( J ).NE.ZERO ) THEN
               TEMP = ALPHA * X( J )
               DO 90, I = ROWPTR( J ), (ROWPTR( J+1 ) - 1)
                  Y( COLIND( I )) = Y( COLIND( I ))
     $                 + VAL( I ) * TEMP
 90            CONTINUE
            ENDIF
 100     CONTINUE
      ENDIF
*
*     Normal termination
*
      RETURN
*
* Format handling
*
*
* Error handling
*
 9998 CONTINUE
      WRITE(IOIMP,*) 'Dimension or increment lower than 1'
      WRITE(IOIMP,*) 'transmitted to subroutine dmomv'
      WRITE(IOIMP,*) 'nothing done'
      RETURN
 9999 CONTINUE
      WRITE(IOIMP,*) 'Wrong option for TRANS'
      WRITE(IOIMP,*) 'transmitted to subroutine dmomv'
      WRITE(IOIMP,*) 'nothing done'
      RETURN
*
*     End of DMOMV.
*
      END