Télécharger la plaquette Cast3M


fr en

Télécharger mulab.eso

Retour à la liste

Numérotation des lignes : 

mulab

  1. C MULAB     SOURCE    AM        12/02/28    00:28:36     7289
  2.  
  3.  
  4.       SUBROUTINE MULAB(A,B,R,ia,ja,ib,jb)
  5. C
  6. C     ***************************************************************
  7. C     *                                                             *
  8. C     *            MULTIPLICATION OF TWO MATRIX                     *
  9. C     *            ----------------------------                     *
  10. C     *                                                             *
  11. C     *   INPUT : A,B : MATRIX TO MULTIPLY                          *
  12. C     *                                                             *
  13. C     *  OUTPUT :   R : RESULT                                      *
  14. C     *                                                             *
  15. C     ***************************************************************
  16. C
  17.       IMPLICIT REAL*8 (A-B,D-H,O-Z)
  18.       implicit integer (I-K,M,N)
  19.       implicit logical (L)
  20.       implicit character*10 (C)
  21.  
  22.       parameter (idimrloc = 441)
  23.  
  24.       DIMENSION A(ia,ja),B(ib,jb),R(ia,jb)
  25.  
  26.       dimension rloc(idimrloc)
  27.  
  28. c     rloc is introduced to allow the results of R to be stored in A or in B
  29. c     Example : Call mulAB(A,B,A,...)
  30. c          or   Call mulAB(A,B,B,...)
  31.  
  32.       i0 = 0
  33.       i1 = 1
  34.       i3 = 3
  35.       i6 = 6
  36.       r0 = 0.
  37.  
  38.       if (ia*jb.gt.idimrloc) then
  39.         write(2,3)ia,jb,ia*jb,idimrloc
  40.     3   format(' ERROR from subr. MULAB.'/
  41.      .  '   The dimensions of the result matrix are ',i3,'X',i3,' = ',
  42.      .  i6,' > ',i6/
  43.      .  '   Change idimrloc in MULAB')
  44.         stop
  45.       endif
  46.  
  47.       if (ja.ne.ib) then
  48.         write(2,2000) ia,ja,ib,jb
  49.         write(*,2000) ia,ja,ib,jb
  50.  2000   format(' ERROR in subr. MULAB.'/
  51.      .         ' It is impossible to multiply a matrix of dimensions',I3
  52.      .  ,' x',i3/
  53.      .         '                           by a matrix of dimensions',I3
  54.      .  ,' x',i3)
  55.         stop
  56.       endif
  57.  
  58.       iloc = i0
  59.       DO 1 j=i1,jb
  60.         DO 1 i=i1,ia
  61.           iloc = iloc+i1
  62.           SUM = r0
  63.           DO 2 K=i1,ja
  64.              SUM = SUM+A(i,K)*B(K,j)
  65.     2     continue
  66.           rloc(iloc) = SUM
  67. c        end do
  68.     1 continue
  69.  
  70.       call AequalB(R,rloc,ia,jb,i1,i1)
  71. c     **** *******
  72.  
  73.       RETURN
  74.       END
  75.  
  76.  
  77.  
  78.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales