*
* $Id$
*
* $Log$
* Revision 1.1  1996/02/15 17:54:03  mclareni
* Initial revision
*
*
. **************************************
.
.     SUBROUTINE MXEQU( A, B, NI, NJ )           *** F 109 ***
.     DIMENSION A(NI,NI),  B(NJ,NI)
.     SOLVES MATRIX EQUATION  AX = B    FOR X
.     MXEQU JUST TRANSFORMS  MATRIX  A   IF  NJ=0
.     SUBROUTINE MXEQU1( A, B, NI, NJ )
.     SAME AS MXEQU, BUT ASSUMES MATRIX  A  TRANSFORMED BY A PREVIOUS CALL
.     TO MXEQU
.     DO NOTHING IF  NI = 0
. *   ERROR EXIT IF  NI.LT.0 .OR. NJ.LT.0
.     METHOD: MILNE, NUMERICAL CALCULUS
.
. **************************************
 
          AXR$
          FORT$
XA2       EQU       X10
XA5       EQU       X11
XA1       EQU       A0
XA3       EQU       A1
XA6       EQU       A2
XA4       EQU       A3
AL1       EQU       A4
AL2       EQU       A5
AC1       EQU       A9
AC2       EQU       A10
AUX1      EQU       AC1
AUX2      EQU       AC2
INCXA4    EQU       A12
INCXA5    EQU       A14
INCXA2    EQU       A15
HOLDIM1   EQU       A8
HOLDAII   EQU       A7
HOLDNI    EQU       A15+2
HOLDNIM1  EQU       A15+1
RLIG      EQU       R3
RNMI      EQU       R2
RELT      EQU       R1
 
XB3       EQU       A1
XB2       EQU       A2
XC2       EQU       A1
XC3       EQU       A2
HOLDIIM1  EQU       A3
ANIMI     EQU       A3
AB1       EQU       A4
AB2       EQU       A5
AUX3      EQU       AB1
INCXB2    EQU       A7
INCXC2    EQU       A7
HOLDNJ    EQU       A14
HOLDNJM1  EQU       A15
RNJ       EQU       R2
 
SLATE     INFO  2  2
$(2)
SAVX10    RES  1
SAVX11    RES  1
SAVA6     RES  2
SAVA8     RES  2
SAVA10    RES  2
SAVA12    RES  1
SAVA14    RES  2
SAVLOCA   RES  1
SAVBJ     RES  2
 
$(1),FIRS01
          +         'MXEQU1'
MXEQU1*
          L,U       A5,1
          J         MXEQ01
          +         'MXEQU '
MXEQU*
          L,U       A5,0
MXEQ01
#include "ftnors1.inc"
#include "spyuse.inc"
* Ignoring t=pass
          DL        A2,2,XARG         . LOC(NI), LOC(NJ)
          DL        A0,0,XARG         . LOC(A), LOC(B)
          L         A4,0,A2           . NI
          L         A2,0,A3           . NJ
          S         A4,HOLDNI
          JZ        A4,RETUR4         . DO NOTHING IF NI=0
          JGD       A4,$+2
LMJER1    SLJ       GERR$
          TZ        A2
          JN        A2,LMJER1         . ERROR EXIT  IF  NJ.LT.0
          DS        A1,SAVBJ
          DS        A6,SAVA6
          LXI,U     XA1,1
          DS        A14,SAVA14
          S         A4,HOLDNIM1
          JNZ       A5,MXQ101
          S         X11,SAVX11
          S         X10,SAVX10
          S         A0,SAVLOCA
          DS        A8,SAVA8
          L         XA5,XA1
          DS        A10,SAVA10
          S         A4,RLIG
          S         A12,SAVA12
          L,U       HOLDIM1,0         . I-1
          LXI       XA5,HOLDNI
          J         MXEQ70
.
. TRANSFORM MATRIX  A
.
MXEQ40
          L         RNMI,RLIG
MXEQ42
          ANU,U     HOLDIM1,1         .  I - 2
          L         AL1,0,XA3
          S         HOLDIM1+1,RELT
          L         AC1,0,XA6
          JZ        HOLDIM1,MXEQ50
MXEQ44
          L         AL2,0,*XA1
          L         AC2,0,*XA4
          FM        AL2,0,*XA2
          FM        AC2,0,*XA5
          FAN       AL1,AL2
          FAN       AC1,AC2
          JGD       RELT,MXEQ44
MXEQ50
          FD        AL1,HOLDAII
          L         AC2,0,*XA4
          S         AL1,0,*XA3
          A         XA4,INCXA4
          FM        AC2,0,XA5
          AN        XA1,HOLDIM1
          FAN       AC1,AC2
          A         XA2,INCXA2
          S         AC1,0,*XA6
          A         XA5,INCXA5
          JGD       RNMI,MXEQ42
          A,U       HOLDIM1,1         . (I-1) = (I-1) + 1
          A         XA1,HOLDNI        . 1. +NI
MXEQ70
          AU        XA1,HOLDIM1       . 1. LOC(A(I,I))
          DLN       AUX1,HOLDNIM1     . 2.
          L         HOLDAII,0,XA1+1   . 1. A(I,I)
          A,U       XA5,1
          A         AUX1,HOLDIM1      . 2.  -(NI-I)
          A,U       XA3,1             . 1.
          MSI       AUX2,HOLDIM1       . 2. -NI*(I-1)
          AU        XA3,HOLDNI        . 1.
          SN        AUX1,INCXA4       . 2.
          ANU       XA6,HOLDIM1       . 1. TO GET XA4
          AU,U      AUX2,1            . -NI*(I-1) + 1
          AN,U      XA4,1             . 1.
          DS        AUX2,INCXA5
          LXI       XA6,HOLDNI
          S         XA5,XA2
          JGD       RLIG,MXEQ40
 
          L         X10,SAVX10
          L         X11,SAVX11
          L         A0,SAVLOCA
          DL        A1,SAVBJ
          DL        A8,SAVA8
          DL        A10,SAVA10
          L         A12,SAVA12
.
.     TRANSFORM MATRIX  B
.
MXQ101
          JZ        A2,MXQFIN
          ANU,U     A2,1              . NJ - 1
          DS        A2,HOLDNJ
          L         RLIG,HOLDNI
          L         XB2,XB3
          L,U       HOLDIIM1,0        .  I-1
          LXI       XB2,HOLDNJ
          LXI,U     XB3,1
          J         MXQ170
MXQ140
          L         RNJ,HOLDNJM1
MXQ142
          ANU,U     HOLDIIM1,1
          S         HOLDIIM1+1,RELT
          L         AB1,0,XB3
          JZ        HOLDIIM1,MXQ150
MXQ144
          L         AB2,0,*XA1
          FM        AB2,0,*XB2
          FAN       AB1,AB2
          JGD       RELT,MXQ144
MXQ150
          FD        AB1,0,XA1
          AN        XB2,INCXB2
          S         AB1,0,*XB3
          AN        XA1,HOLDIIM1
          JGD       RNJ,MXQ142
          A,U       HOLDIIM1,1        .  (I-1) = (I-1) + 1
          A         XA1,HOLDNI
          LXM       XB2,SAVBJ
MXQ170
          L         AUX3,HOLDNJ       . NJ
          MSI       AUX3,HOLDIIM1     . NJ*(I-1)
          AN,U      AUX3,1            . NJ*(I-1) - 1
          S         AUX3,INCXB2
          JGD       RLIG,MXQ140
.
.     GET SOLUTION  X  (STORED INTO B )
.
          AN,U      XB3,1             . BECOMES XC2
          L,U       ANIMI,1           . NI - I
          ANU       XC2,HOLDNJ        . BECOMES XC3
          L         RLIG,HOLDNIM1
          LXI       XC2,HOLDNJ
          LXI,U     XC3,-1
          J         MXQ270
MXQ240
          L         RNJ,HOLDNJM1
MXQ242
          ANU,U     ANIMI,1
          S         ANIMI+1,RELT
          L         AB1,0,XC3
MXQ244
          L         AB2,0,*XA1
          FM        AB2,0,*XC2
          FAN       AB1,AB2
          JGD       RELT,MXQ244
          S         AB1,0,*XC3
          AN        XA1,ANIMI
          AN        XC2,INCXC2
          JGD       RNJ,MXQ242
          A,U       ANIMI,1           . (NI-I) = (NI-I) + 1
MXQ270
          L         AUX3,HOLDNJ
          AN        XA1,HOLDNI
          MSI       AUX3,ANIMI        . NJ*(NI-I)
          AN,U      XA1,1
          A,U       AUX3,1            . NJ*(NI-I) + 1
          S         AUX3,INCXC2
          JGD       RLIG,MXQ240
MXQFIN
          DL        A14,SAVA14
          DL        A6,SAVA6
          J         RETUR4
 
#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,MXEQU
          +         DYN$
          +         'MXEQU,MXEQU1'
LDIAG1    EQU       $-DIAG1
DIAG11    +         0776102,MXEQU1
          +         DIAG1
          ON    GERMAX
DIAG2     +         0776702,0
          +         LMJER1-FIRS01,DYN$
DIAG3     F         077,047,LDIAG3,LMJER1+1
          +         LDIAG3-2,DIAG2
 'MXEQU,EQU1(,,NI,NJ) ERROR: NI<0 OR NJ<0'
LDIAG3    EQU       $-DIAG3
          OFF . GERMAX
          ON    GERMAX=0
DIAG2     +         0776202,LMJER1+1
          +         LMJER1-FIRS01,DIAG1
          OFF . GERMAX=0
#endif
          END
#ifdef CERNLIB_TCGEN_MXEQU
#undef CERNLIB_TCGEN_MXEQU
#endif
