Numérotation des lignes :

C MULATB    SOURCE    AM        12/02/28    00:28:37     7289        SUBROUTINE MULATB(A,B,R,ia,ja,ib,jb)CC     ***************************************************************C     *                                                             *C     *            MULTIPLICATION OF Atranspose BY B                *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(ja,jb)       dimension rloc(idimrloc) c     rloc is introduced to allow the results of R to be stored in A or in Bc     Example : Call mulATB(A,B,A,...)c          or   Call mulATB(A,B,B,...)       i1 = 1      i0 = 0      i3 = 3      i6 = 6      r0 = 0.       if (ja*jb.gt.idimrloc) then        write(2,3)ja,jb,ja*jb,idimrloc    3   format(' ERROR from subr. MULATB.'/     .  '   The dimensions of the result matrix are ',i3,'X',i3,' = ',     .  i6,' > ',i6/     .  '   Change idimrloc in MULATB')        stop      endif       if (ia.ne.ib) then        write(2,2000) ja,ia,ib,jb        write(*,2000) ja,ia,ib,jb 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,jb        DO 1 I=i1,ja          iloc = iloc+i1          SUM = r0          DO 2 K=i1,ia             SUM = SUM+A(K,I)*B(K,J)    2     CONTINUE          rloc(iloc) = SUM    1 CONTINUE       call AequalB(R,rloc,ja,jb,i1,i1)c     **** *******       RETURN      END

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