Esope source files

   1 : C MULAB     SOURCE    AM        12/02/28    00:28:36     7289           
   2 : 
   3 : 
   4 :       SUBROUTINE MULAB(A,B,R,ia,ja,ib,jb)
   5 : C                                                                     
   6 : C     *************************************************************** 
   7 : C     *                                                             * 
   8 : C     *            MULTIPLICATION OF TWO MATRIX                     * 
   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,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 mulAB(A,B,A,...)
  28 : c          or   Call mulAB(A,B,B,...)
  29 : 
  30 :       i0 = 0
  31 :       i1 = 1
  32 :       i3 = 3
  33 :       i6 = 6
  34 :       r0 = 0.
  35 :                         
  36 :       if (ia*jb.gt.idimrloc) then
  37 :         write(2,3)ia,jb,ia*jb,idimrloc
  38 :     3   format(' ERROR from subr. MULAB.'/
  39 :      .  '   The dimensions of the result matrix are ',i3,'X',i3,' = ',
  40 :      .  i6,' > ',i6/
  41 :      .  '   Change idimrloc in MULAB')      
  42 :         stop
  43 :       endif
  44 : 
  45 :       if (ja.ne.ib) then
  46 :         write(2,2000) ia,ja,ib,jb
  47 :         write(*,2000) ia,ja,ib,jb
  48 :  2000   format(' ERROR in subr. MULAB.'/
  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,ia
  59 :           iloc = iloc+i1
  60 :           SUM = r0
  61 :           DO 2 K=i1,ja                                                
  62 :              SUM = SUM+A(i,K)*B(K,j)                                
  63 :     2     continue                                                  
  64 :           rloc(iloc) = SUM                                              
  65 : c        end do       
  66 :     1 continue
  67 : 
  67 :       call AequalB(R,rloc,ia,jb,i1,i1)
  68 : c     **** *******
  69 : 
  70 :       RETURN                                                          
  71 :       END      
  72 : 
  73 : 
  74 :