Esope source files

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