muls.f

Go to the documentation of this file.

      SUBROUTINE mulku(VKGS,VKGD,VKGI,KLD,VFG,NEQ,NSYM,VRES,nsky)       !MULK   1
C=======================================================================MULK   2
C     CE SOUS-PROGRAMME AJOUTE AU VECTEUR RES LE PRODUIT DE LA          MULK   3
C     MATRICE KG PAR LE VECTEUR FG                                      MULK   4
C       ENTREES                                                         MULK   5
C          VKGS,VKGD,VKGI  MATRICE KG STOCKEE PAR LIGNE DE CIEL (SYM.   MULK   6
C                          OU NON SYM.)                                 MULK   7
C          KLD     TABLE DES POINTEURS DES HAUTS DE COLONNES DE KG      MULK   8
C          VFG     VECTEUR FG                                           MULK   9
C          NEQ     DIMENSION DES VECTEURS FG ET RES                     MULK  10
C          NSYM    .EQ.1 SI LE PROBLEME N'EST PAS SYMETRIQUE            MULK  11
C          VRES    VECTEUR RES                                          MULK  12
C       SORTIE                                                          MULK  13
C          VRES    VECTEUR RES                                          MULK  14
C=======================================================================MULK  15
      IMPLICIT REAL(8)(a-h,o-z)                                         !MULK  16
      dimension vkgs(nsky),vkgd(neq),vkgi(nsky),
     &  kld(neq+1),vfg(neq),vres(neq)                                   !MULK  17
C-----------------------------------------------------------------------MULK  18
C-------  POUR CHAQUE COLONNE DE LA MATRICE KG                          MULK  19
      DO ik=1,neq                                                    !MULK  20
      jhk=kld(ik)                                                       !MULK  21
      jhk1=kld(ik+1)                                                    !MULK  22
      lhk=jhk1-jhk                                                      !MULK  23
C-------  TERME DIAGONAL                                                !MULK  24
      c=vkgd(ik)*vfg(ik)                                                !MULK  25
      IF(lhk.LE.0) GO TO 20                                             !MULK  26
      i0=ik-lhk                                                         !MULK  27
C-------  TERMES DE LIGNE                                               MULK  28
      IF(nsym.NE.1) c=c+scal(vkgs(jhk),vfg(i0),lhk)                     !MULK  29
      IF(nsym.EQ.1) c=c+scal(vkgi(jhk),vfg(i0),lhk)                     !MULK  30
C-------  TERMES DE COLONNE                                             MULK  31
      j=jhk                                                             !MULK  32
      i1=ik-1                                                           !MULK  33
      DO ij=i0,i1                                                       !MULK  34
      vres(ij)=vres(ij)+vkgs(j)*vfg(ik)                                 !MULK  35
      j=j+1                                                             !MULK  36
      END DO
20    vres(ik)=vres(ik)+c                                               !MULK  37
      END DO
      RETURN                                                            !MULK  38
      END                                                               !MULK  39