C MULABT    SOURCE    AM        12/02/28    00:28:37     7289


      SUBROUTINE MULABT(A,B,R,ia,ja,ib,jb)
C
C     ***************************************************************
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 B
c     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