Esope source files

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