Numérotation des lignes :

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

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