Esope source files

   1 : C GMOMVF    SOURCE    GOUNAND   11/10/07    21:15:29     7149           
   2 :       SUBROUTINE GMOMVF(IMVEC,ITRAN,N,ALPHA,NNZ,ROWPTR,COLIND,VAL,X,
   3 :      $     BETA,Y,
   4 :      $     ithr,nbthr)
   5 :       IMPLICIT REAL*8 (A-H,O-Z)
   6 :       IMPLICIT INTEGER (I-N)
   7 : C***********************************************************************
   8 : C NOM         : GMOMVF
   9 : C DESCRIPTION : Partie en fortran du produit matrice-vecteur
  10 : C
  11 : C
  12 : C
  13 : C LANGAGE     : ESOPE
  14 : C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  15 : C               mél : gounand@semt2.smts.cea.fr
  16 : C***********************************************************************
  17 : C APPELES          : 
  18 : C APPELES (E/S)    : 
  19 : C APPELES (BLAS)   :
  20 : C APPELES (CALCUL) :
  21 : C APPELE PAR       :
  22 : C***********************************************************************
  23 : C SYNTAXE GIBIANE    :
  24 : C ENTREES            :
  25 : C ENTREES/SORTIES    :
  26 : C SORTIES            :
  27 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  28 : C***********************************************************************
  29 : C VERSION    : v1, 08/01/2008, version initiale
  30 : C HISTORIQUE : v1, 08/01/2008, création
  31 : C HISTORIQUE :
  32 : C HISTORIQUE :
  33 : C***********************************************************************
  34 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  35 : C en cas de modification de ce sous-programme afin de faciliter
  36 : C la maintenance !
  37 : C***********************************************************************
  38 : *     .. Scalar Arguments ..
  39 :       REAL*8             ALPHA, BETA
  40 :       INTEGER            N, NNZ,ITRAN
  41 :       CHARACTER*1        TRANS
  42 : *     .. Array Arguments ..
  43 : *     .. Morse Matrix
  44 :       INTEGER ROWPTR( N+1 )
  45 :       INTEGER COLIND( NNZ )
  46 :       REAL*8  VAL( NNZ )
  47 : *     .. Vectors
  48 :       REAL*8     X( N ), Y( N )
  49 : *     .. Parameters ..
  50 :       REAL*8             ONE         , ZERO
  51 :       PARAMETER        ( ONE = 1.0D+0, ZERO = 0.0D+0 )
  52 : *     
  53 : *     Quick return if possible.
  54 : *     
  55 :       IF( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) 
  56 :      $     RETURN
  57 :       ISTRAT=IMVEC
  58 : *
  59 : * Stratégie 1 : une ligne pour proc 1, la suivante pour proc 2...
  60 : *
  61 :       IF (ISTRAT.EQ.1) THEN
  62 : *     First form  y := beta*y.
  63 :          IF (BETA.NE.ONE)THEN
  64 :             IF (BETA.EQ.ZERO)THEN
  65 :                DO 10 I=ithr,N,nbthr
  66 :                   Y(I)=ZERO
  67 :  10            CONTINUE
  68 :             ELSE
  69 :                DO 20 I=ithr,N,nbthr
  70 :                   Y(I)=BETA*Y(I)
  71 :  20            CONTINUE
  72 :             END IF
  73 :          END IF
  74 :          IF (ALPHA.EQ.ZERO) RETURN
  75 : *     Form  y := alpha*A*x + y.
  76 :          IF (ITRAN.EQ.0) THEN
  77 :             DO 60 I=ithr,N,nbthr
  78 :                DO 50 J=ROWPTR(I),(ROWPTR(I+1)-1)
  79 :                   Y(I)=Y(I)+(ALPHA*VAL(J)*X(COLIND(J)))
  80 :  50            CONTINUE
  81 :  60         CONTINUE
  82 :          ELSE
  83 :             DO 61 J=ithr,N,nbthr
  84 :                IF (X(J).NE.ZERO) THEN
  85 :                   XTMP=ALPHA*X(J)
  86 :                   DO 51 I=ROWPTR(J),(ROWPTR(J+1)-1)
  87 :                      Y(COLIND(I))=Y(COLIND(I))+(VAL(I)*XTMP)
  88 :  51               CONTINUE
  89 :                ENDIF
  90 :  61         CONTINUE
  91 :          ENDIF
  92 : *
  93 : * Stratégie : bloc de lignes consécutives pour chaque proc
  94 : *
  95 :       ELSE
  96 : *     First form  y := beta*y.
  97 :          ideb = (((ithr-1)*n)/nbthr)+1
  98 :          iend = (ithr*n)/nbthr
  99 :          IF (BETA.NE.ONE)THEN
 100 :             IF (BETA.EQ.ZERO)THEN
 101 :                DO 110 I=ideb,iend
 102 :                   Y(I)=ZERO
 103 :  110           CONTINUE
 104 :             ELSE
 105 :                DO 120 I=ideb,iend
 106 :                   Y(I)=BETA*Y(I)
 107 :  120           CONTINUE
 108 :             END IF
 109 :          END IF
 110 :          IF (ALPHA.EQ.ZERO) RETURN
 111 : *     Form  y := alpha*A*x + y.
 112 :          IF (ITRAN.EQ.0) THEN
 113 :             DO 160 I=ideb,iend
 114 :                DO 150 J=ROWPTR(I),(ROWPTR(I+1)-1)
 115 :                   Y(I)=Y(I)+(ALPHA*VAL(J)*X(COLIND(J)))
 116 :  150           CONTINUE
 117 :  160        CONTINUE
 118 :          ELSE
 119 :             DO 161 J=ideb,iend
 120 :                IF (X(J).NE.ZERO) THEN
 121 :                   XTMP=ALPHA*X(J)
 122 :                   DO 151 I=ROWPTR(J),(ROWPTR(J+1)-1)
 123 :                      Y(COLIND(I))=Y(COLIND(I))+(VAL(I)*XTMP)
 124 :  151              CONTINUE
 125 :                ENDIF
 126 :  161        CONTINUE
 127 :          ENDIF
 128 :       ENDIF
 129 : C
 129 : C      CALL DMOMV ('No transpose',N,ALPHA, 
 130 : C     $     NNZ,KMORS.IA,KMORS.JA,KISA.A,
 131 : C     $     X.A,BETA,Y.A)
 132 : *
 133 : * Normal termination
 134 : *
 135 :       RETURN
 136 : *
 137 : * End of subroutine GMOMVF
 138 : *
 139 :       END
 140 : 
 141 :  
 142 :  
 143 :  
 144 :