Numérotation des lignes :

C MULABT    SOURCE    AM        12/02/28    00:28:37     7289        SUBROUTINE MULABT(A,B,R,ia,ja,ib,jb)CC     ***************************************************************C     *                                                             *C     *            MULTIPLICATION OF A BY Btranspose                *C     *            ---------------------------------                *C     *                                                             *C     *   INPUT : A,B : MATRIX TO MULTIPLY                          *C     *                                                             *C     *  OUTPUT :   R : RESULT                                      *C     *                                                             *C     ***************************************************************C      IMPLICIT REAL*8 (A-B,D-H,O-Z)      implicit integer (I-K,M,N)      implicit logical (L)      implicit character*10 (C)       parameter (idimrloc = 441)       DIMENSION A(ia,ja),B(ib,jb),R(ia,ib)       dimension rloc(idimrloc) c     rloc is introduced to allow the results of R to be stored in A or in Bc     Example : Call mulABT(A,B,A,...)c          or   Call mulABT(A,B,B,...)       i1 = 1      i0 = 0      i3 = 3      i6 = 6      r0 = 0.       if (ia*ib.gt.idimrloc) then        write(2,3)ia,ib,ia*ib,idimrloc    3   format(' ERROR from subr. MULABT.'/     .  '   The dimensions of the result matrix are ',i3,'X',i3,' = ',     .  i6,' > ',i6/     .  '   Change idimrloc in MULABT')        stop      endif        if (ja.ne.jb) then        write(2,2000) ia,ja,jb,ib        write(*,2000) ia,ja,jb,ib 2000   format(' ERROR in subr. MULATB.'/     .         ' It is impossible to multiply a matrix of dimensions',I3     .  ,' x',i3/     .         '                           by a matrix of dimensions',I3     .  ,' x',i3)        stop      endif       iloc = i0      DO 1 j=i1,ib         DO 1 i=i1,ia            iloc = iloc+i1            SUM = r0            DO 2 K=i1,ja               SUM = SUM+A(I,K)*B(J,K)    2       CONTINUE            rloc(iloc) = SUM    1 CONTINUE       call AequalB(R,rloc,ia,ib,i1,i1)c     **** *******       RETURN      END

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