Télécharger la plaquette Cast3M


fr en

Télécharger mulabt.eso

Retour à la liste

Numérotation des lignes : 

mulabt

  1. C MULABT    SOURCE    AM        12/02/28    00:28:37     7289
  2.  
  3.  
  4.       SUBROUTINE MULABT(A,B,R,ia,ja,ib,jb)
  5. C
  6. C     ***************************************************************
  7. C     *                                                             *
  8. C     *            MULTIPLICATION OF A BY Btranspose                *
  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,ib)
  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 mulABT(A,B,A,...)
  30. c          or   Call mulABT(A,B,B,...)
  31.  
  32.       i1 = 1
  33.       i0 = 0
  34.       i3 = 3
  35.       i6 = 6
  36.       r0 = 0.
  37.  
  38.       if (ia*ib.gt.idimrloc) then
  39.         write(2,3)ia,ib,ia*ib,idimrloc
  40.     3   format(' ERROR from subr. MULABT.'/
  41.      .  '   The dimensions of the result matrix are ',i3,'X',i3,' = ',
  42.      .  i6,' > ',i6/
  43.      .  '   Change idimrloc in MULABT')
  44.         stop
  45.       endif
  46.  
  47.  
  48.       if (ja.ne.jb) then
  49.         write(2,2000) ia,ja,jb,ib
  50.         write(*,2000) ia,ja,jb,ib
  51.  2000   format(' ERROR in subr. MULATB.'/
  52.      .         ' It is impossible to multiply a matrix of dimensions',I3
  53.      .  ,' x',i3/
  54.      .         '                           by a matrix of dimensions',I3
  55.      .  ,' x',i3)
  56.         stop
  57.       endif
  58.  
  59.       iloc = i0
  60.       DO 1 j=i1,ib
  61.          DO 1 i=i1,ia
  62.             iloc = iloc+i1
  63.             SUM = r0
  64.             DO 2 K=i1,ja
  65.                SUM = SUM+A(I,K)*B(J,K)
  66.     2       CONTINUE
  67.             rloc(iloc) = SUM
  68.     1 CONTINUE
  69.  
  70.       call AequalB(R,rloc,ia,ib,i1,i1)
  71. c     **** *******
  72.  
  73.       RETURN
  74.       END
  75.  
  76.  
  77.  
  78.  

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