*
* $Id$
*
* $Log$
* Revision 1.1  1996/02/15 17:54:04  mclareni
* Initial revision
*
*
. **************************************
.
.     SUBROUTINE MXMPY ( A, B, X, NI, NJ, NK )   *** F 110 ***
.     DIMENSION A(NJ,NI), B(NK,NJ), X(NK,NI)
.     X = A*B
.     IF  NJ=0   X IS FILLED WITH ZEROS
.     SUBROUTINE MXMAD ( A, B, X, NI, NJ, NK )
.     X = A*B + X
.     IF  NJ=0   X IS NOT MODIFIED
.     SUBROUTINE MXMUB ( A, B, X, NI, NJ, NK )
.     X = A*B - X
.     IF  NJ=0   X IS REPLACED BY -X
. *   ERROR EXIT IF NI.LE.0 .OR. NJ.LT.0 .OR. NK.LE.0
.
.     SUBROUTINE MXMPY1( A, Q, X, NI, NJ, NK )   *** F 110 ***
.     DIMENSION A(NJ,NI), Q(NJ,NK), X(NK,NI)
.     X = A*QT
.     SUBROUTINE MXMAD1( A, Q, X, NI, NJ, NK )
.     X = A*QT + X
.     SUBROUTINE MXMUB1( A, Q, X, NI, NJ, NK )
.     X = A*QT - X
.
.     SUBROUTINE MXMPY2( P, B, X, NI, NJ, NK )   *** F 110 ***
.     DIMENSION P(NI,NJ), B(NK,NJ), X(NK,NI)
.     X = PT*B
.     SUBROUTINE MXMAD2( A, Q, X, NI, NJ, NK )
.     X = PT*B + X
.     SUBROUTINE MXMUB2( A, Q, X, NI, NJ, NK )
.     X = PT*B - X
.
.     SUBROUTINE MXMPY3( P, Q, X, NI, NJ, NK )   *** F 110 ***
.     DIMENSION P(NI,NJ), Q(NJ,NK), X(NI,NK)
.     X = PT*QT
.     SUBROUTINE MXMAD3( P, Q, X, NI, NJ, NK )
.     X = PT*QT + X
.     SUBROUTINE MXMUB3( P, Q, X, NI, NJ, NK )
.     X = PT*QT - X
.
. **************************************
 
          AXR$
          FORT$
HOLDKM1   EQU       A15+2
HOLDJ     EQU       A15+1
 
$(0)
ADDX      LA        A3,0,A2            . X(K,I)
SUBX      LNA       A3,0,A2            . -X(K,I)
NOX       SZ        A3
 
$(1),FIRS01
          +         'MXMAD3'
MXMAD3*   L         A4,ADDX
          LN,XU     A5,2
          J         MXMP01
          +         'MXMUB3'
MXMUB3*   L         A4,SUBX
          LN,XU     A5,2
          J         MXMP01
          +         'MXMPY3'
MXMPY3*   L         A4,NOX
          LN,XU     A5,2
          J         MXMP01
 
          +         'MXMAD2'
MXMAD2*   L         A4,ADDX
          LN,XU     A5,1
          J         MXMP01
          +         'MXMUB2'
MXMUB2*   L         A4,SUBX
          LN,XU     A5,1
          J         MXMP01
          +         'MXMPY2'
MXMPY2*   L         A4,NOX
          LN,XU     A5,1
          J         MXMP01
 
          +         'MXMAD1'
MXMAD1*   L         A4,ADDX
          L,U       A5,1
          J         MXMP01
          +         'MXMUB1'
MXMUB1*   L         A4,SUBX
          L,U       A5,1
          J         MXMP01
          +         'MXMPY1'
MXMPY1*   L         A4,NOX
          L,U       A5,1
          J         MXMP01
 
          +         'MXMAD '
MXMAD*    L         A4,ADDX
          J         MXMP00
          +         'MXMUB '
MXMUB*    L         A4,SUBX
          J         MXMP00
          +         'MXMPY '
MXMPY*    L         A4,NOX
MXMP00    L,U       A5,0
MXMP01
#include "ftnors1.inc"
#include "spyuse.inc"
* Ignoring t=pass
          DL        A1,4,XARG          . LOC(NJ), LOC(NK)
          S         A4,MXMP43
          L         R2,0,A2            . NK
          DL        A2,2,XARG          . LOC(X), LOC(NI)
          L         R1,0,A1            . NJ
          DL        A0,0,XARG          . LOC(A), LOC(B)
          LXI,U     A2,1
          L         R3,0,A3            . NI
          S,H2      A1,INCAA1
          DL        A3,R1             . NJ, NK
          JB        A5,MXMP20
          MSI       A4,A3             . NJ*NK
          LXI       A1,R2             . NK
          AN,U      A4,1              . NJ*NK-1
          JN        A5,MXMP22
MXMP18    L         A5,A3             . NJ
          LXI,U     A0,1
          J         MXMP24
MXMP20    LXI,U     A1,1
          L,U       A4,0
          JP        A5,MXMP18
MXMP22    MSI       A3,R3             . NI*NJ
          LXI       A0,R3             . NI
          L,U       A5,1
MXMP24    SM,H2     A4,INCA1
          SM,H2     A3,INCA0
          SM,H2     A5,INCAA0
          JGD       R3,$+2             . NI-1
          J         LMJER1
          JGD       R2,$+2             . NK-1
          J         LMJER1
          JZ        A3,$+3            . (A3=NJ OR NI*NJ)
          TP        R1
LMJER1    SLJ       GERR$
          S         R2,HOLDKM1
          S         R1,HOLDJ
MXMP40                                . LOOP  NI
          L         R2,HOLDKM1        . NK - 1
MXMP42                                . LOOP  NK
MXMP43    +         $-$                . SZ  OR  L  OR  LN  A3
          L         R1,HOLDJ           . NJ-1
          J         MXMP50
MXMP44                                 . LOOP NJ
          L         A4,0,*A1           . B(K,J)
          FM        A4,0,*A0           . A(J,I)
          FA        A3,A4
MXMP50    JGD       R1,MXMP44
          S         A3,0,*A2           . C(K,I)
INCA0     AN,U      A0,$-$
INCA1     AN,U      A1,$-$
          JGD       R2,MXMP42
INCAA0    A,U       A0,$-$
INCAA1    LXM,U     A1,$-$            .  INC, LOC(B)
          JGD       R3,MXMP40
          J         RETUR6
#if (defined(CERNLIB_GUYDIAGP))&&(defined(CERNLIB_GUYFORT))
.     DIAGNOSTIC PACKETS
#include "gerr_c.inc"
F         FORM      6,6,6,18
          INFO  010  03
$(3),DIAG1 F        077,050,LDIAG1,MXMPY
          +         DYN$
          +         'MXMP.PACKAGE'
LDIAG1    EQU       $-DIAG1
DIAG11    +         0775102,MXMPY1
          +         DIAG1
DIAG21    +         0775102,MXMPY2
          +         DIAG1
DIAG31    +         0775102,MXMPY3
          +         DIAG1
DIAG41    +         0775102,MXMAD
          +         DIAG1
DIAG51    +         0775102,MXMAD1
          +         DIAG1
DIAG61    +         0775102,MXMAD2
          +         DIAG1
DIAG71    +         0775102,MXMAD3
          +         DIAG1
DIAG81    +         0775102,MXMUB
          +         DIAG1
DIAG91    +         0775102,MXMUB1
          +         DIAG1
DIAG101   +         0775102,MXMUB2
          +         DIAG1
DIAG111   +         0775102,MXMUB3
          +         DIAG1
          ON    GERMAX
DIAG2     +         0776702,0
          +         LMJER1-FIRS01,DYN$
DIAG3     F         077,047,LDIAG3,LMJER1+1
          +         LDIAG3-2,DIAG2
 'MXMP..(,,,NI,NJ,NK) ERROR: NI.LE.0 OR NJ<0 OR NK.LE.0'
LDIAG3    EQU       $-DIAG3
          OFF . GERMAX
          ON    GERMAX=0
DIAG2     +         0776202,LMJER1+1
          +         LMJER1-FIRS01,DIAG1
          OFF . GERMAX=0
#endif
          END
#ifdef CERNLIB_TCGEN_MXMPY
#undef CERNLIB_TCGEN_MXMPY
#endif
