Sources Esope | Cast3M

gmomvf
C GMOMVF    SOURCE    GOUNAND   11/10/07    21:15:29     7149
      SUBROUTINE GMOMVF(IMVEC,ITRAN,N,ALPHA,NNZ,ROWPTR,COLIND,VAL,X,
     $     BETA,Y,
     $     ithr,nbthr)
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : GMOMVF
C DESCRIPTION : Partie en fortran du produit matrice-vecteur
C
C
C
C LANGAGE     : ESOPE
C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
C               mél : gounand@semt2.smts.cea.fr
C***********************************************************************
C APPELES          :
C APPELES (E/S)    :
C APPELES (BLAS)   :
C APPELES (CALCUL) :
C APPELE PAR       :
C***********************************************************************
C SYNTAXE GIBIANE    :
C ENTREES            :
C ENTREES/SORTIES    :
C SORTIES            :
C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
C***********************************************************************
C VERSION    : v1, 08/01/2008, version initiale
C HISTORIQUE : v1, 08/01/2008, 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,ITRAN
      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 )
*     .. Parameters ..
      REAL*8             ONE         , ZERO
      PARAMETER        ( ONE = 1.0D+0, ZERO = 0.0D+0 )
*
*     Quick return if possible.
*
      IF( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) )
     $     RETURN
      ISTRAT=IMVEC
*
* Stratégie 1 : une ligne pour proc 1, la suivante pour proc 2...
*
      IF (ISTRAT.EQ.1) THEN
*     First form  y := beta*y.
         IF (BETA.NE.ONE)THEN
            IF (BETA.EQ.ZERO)THEN
               DO 10 I=ithr,N,nbthr
                  Y(I)=ZERO
 10            CONTINUE
            ELSE
               DO 20 I=ithr,N,nbthr
                  Y(I)=BETA*Y(I)
 20            CONTINUE
            END IF
         END IF
         IF (ALPHA.EQ.ZERO) RETURN
*     Form  y := alpha*A*x + y.
         IF (ITRAN.EQ.0) THEN
            DO 60 I=ithr,N,nbthr
               DO 50 J=ROWPTR(I),(ROWPTR(I+1)-1)
                  Y(I)=Y(I)+(ALPHA*VAL(J)*X(COLIND(J)))
 50            CONTINUE
 60         CONTINUE
         ELSE
            DO 61 J=ithr,N,nbthr
               IF (X(J).NE.ZERO) THEN
                  XTMP=ALPHA*X(J)
                  DO 51 I=ROWPTR(J),(ROWPTR(J+1)-1)
                     Y(COLIND(I))=Y(COLIND(I))+(VAL(I)*XTMP)
 51               CONTINUE
               ENDIF
 61         CONTINUE
         ENDIF
*
* Stratégie : bloc de lignes consécutives pour chaque proc
*
      ELSE
*     First form  y := beta*y.
         ideb = (((ithr-1)*n)/nbthr)+1
         iend = (ithr*n)/nbthr
         IF (BETA.NE.ONE)THEN
            IF (BETA.EQ.ZERO)THEN
               DO 110 I=ideb,iend
                  Y(I)=ZERO
 110           CONTINUE
            ELSE
               DO 120 I=ideb,iend
                  Y(I)=BETA*Y(I)
 120           CONTINUE
            END IF
         END IF
         IF (ALPHA.EQ.ZERO) RETURN
*     Form  y := alpha*A*x + y.
         IF (ITRAN.EQ.0) THEN
            DO 160 I=ideb,iend
               DO 150 J=ROWPTR(I),(ROWPTR(I+1)-1)
                  Y(I)=Y(I)+(ALPHA*VAL(J)*X(COLIND(J)))
 150           CONTINUE
 160        CONTINUE
         ELSE
            DO 161 J=ideb,iend
               IF (X(J).NE.ZERO) THEN
                  XTMP=ALPHA*X(J)
                  DO 151 I=ROWPTR(J),(ROWPTR(J+1)-1)
                     Y(COLIND(I))=Y(COLIND(I))+(VAL(I)*XTMP)
 151              CONTINUE
               ENDIF
 161        CONTINUE
         ENDIF
      ENDIF
C
C      CALL DMOMV ('No transpose',N,ALPHA,
C     $     NNZ,KMORS.IA,KMORS.JA,KISA.A,
C     $     X.A,BETA,Y.A)
*
* Normal termination
*
      RETURN
*
* End of subroutine GMOMVF
*
      END