MINICERN/packlib/kernlib/kerngen/tcgen/mxmlrt.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/02/15 17:49:52  mclareni
   6 * Kernlib
   7 *
   8 *
   9 #include "kerngen/pilot.h"
  10       SUBROUTINE MXMLRT (A,B,C,NI,NJ)
  11 C
  12 C CERN PROGLIB# F110    MXMLRT          .VERSION KERNFOR  2.00  720707
  13 C ORIG. 01/01/64 RKB
  14 C
  15       DIMENSION A(*),B(*),C(*)
  16 C
  17 C--      ENTRY MXMLRT
  18 C
  19 C--                C = A(I,J) X B(J,J) X A*(J,I)
  20 C--                A* STANDS FOR A-TRANSPOSED
  21 C
  22 C        CALL MXMLRT (A,B,C,NI,NJ)     IS EQUIVALENT TO
  23 C             CALL MXMPY (A,B,X,NI,NJ,NJ)
  24 C             CALL MXMPY1 (X,A,C,NI,NJ,NI)
  25 C
  26 C        OR   CALL MXMPY1 (B,A,Y,NJ,NJ,NI)
  27 C             CALL MXMPY (A,Y,C,NI,NJ,NI)
  28 C
  29       IPA=1
  30       JPA=NJ
  31       GO TO 5
  32 C
  33 #if defined(CERNLIB_ENTRCDC)
  34          ENTRY MXMLTR
  35 #endif
  36 #if !defined(CERNLIB_ENTRCDC)
  37          ENTRY MXMLTR   (A,B,C,NI,NJ)
  38 #endif
  39 C
  40 C--                C = A*(I,J) X B(J,J) X A(J,I)
  41 C
  42 C        CALL MXMLTR (A,B,C,NI,NJ)     IS EQUIVALENT TO
  43 C             CALL MXMPY2 (A,B,X,NI,NJ,NJ)
  44 C             CALL MXMPY (X,A,C,NI,NJ,NI)
  45 C
  46 C        OR   CALL MXMPY (B,A,Y,NJ,NJ,NI)
  47 C             CALL MXMPY2 (A,Y,C,NI,NJ,NI)
  48 C
  49       IPA=NI
  50       JPA=1
  51 C
  52     5 CONTINUE
  53       IF (NI.LE.0) RETURN
  54       IF (NJ.LE.0) RETURN
  55       IC1=1
  56       IA1=1
  57          DO 50 II=1,NI
  58 C
  59       IC=IC1
  60          DO 10 KC=1,NI
  61       C(IC)=0.
  62    10 IC=IC+1
  63 C
  64       IB1=1
  65       JA1=1
  66          DO 40 JJ=1,NJ
  67 C
  68       IB=IB1
  69       IA=IA1
  70       X=0.
  71          DO 20 KJ=1,NJ
  72       X=X + A(IA)*B(IB)
  73       IA=IA+IPA
  74       IB=IB+NJ
  75    20 CONTINUE
  76 C
  77       JA=JA1
  78       IC=IC1
  79          DO 30 KI=1,NI
  80       C(IC)=C(IC) + X*A(JA)
  81       IC=IC+1
  82       JA=JA+JPA
  83    30 CONTINUE
  84 C
  85       IB1=IB1+1
  86       JA1=JA1+IPA
  87    40 CONTINUE
  88 C
  89       IC1=IC1+NI
  90       IA1=IA1+JPA
  91    50 CONTINUE
  92       RETURN
  93       END