Task

Invert matrix   A   using Gauss-Jordan method.

A   being an   n × n   matrix.




*        Gauss-Jordan matrix inversion 17/01/2021
GAUSSJOR CSECT
         USING  GAUSSJOR,R13       base register
         B      72(R15)            skip savearea
         DC     17F'0'             savearea
         SAVE   (14,12)            save previous context
         ST     R13,4(R15)         link backward
         ST     R15,8(R13)         link forward
         LR     R13,R15            set addressability
         LA     R6,1               i=1
       DO  WHILE=(C,R6,LE,N)       do i=1 to n
         LA     R7,1                 j=1
       DO  WHILE=(C,R7,LE,N)         do j=1 to n
         LR     R1,R6                  i
         BCTR   R1,0                   -1
         MH     R1,HN                  *n
         LR     R0,R7                   j
         BCTR   R0,0                   -1
         AR     R1,R0                  (i-1)*n+j-1
         SLA    R1,2                   *4
         LE     F0,AA(R1)              aa(i,j)
         LR     R1,R6                  i
         BCTR   R1,0                   -1
         MH     R1,HN2                 *n*2
         LR     R0,R7                  j
         BCTR   R0,0                   -1
         AR     R1,R0                  (i-1)*n*2+j-1
         SLA    R1,2                   *4
         STE    F0,TMP(R1)             tmp(i,j)=aa(i,j)
         LA     R7,1(R7)               j++
       ENDDO    ,                    enddo j
         LA     R7,1                 j=1
         A      R7,N                 j=n+1
       DO  WHILE=(C,R7,LE,N2)        do j=n+1 to 2*n
         LR     R1,R6                  i
         BCTR   R1,0                   -1
         MH     R1,HN2                 *n*2
         LR     R0,R7                  j
         BCTR   R0,0                   -1
         AR     R1,R0                  (i-1)*n*2+j-1
         SLA    R1,2                   *4
         LE     F0,=E'0'               0
         STE    F0,TMP(R1)             tmp(i,j)=0
         LA     R7,1(R7)               j++
       ENDDO    ,                    enddo j
         LR     R2,R6                i
         A      R2,N                 i+n
         LR     R1,R6                i
         BCTR   R1,0                 -1
         MH     R1,HN2               *n*2
         BCTR   R2,0                 -1
         AR     R1,R2                (i+n-1)*n*2+i-1
         SLA    R1,2                 *4
         LE     F0,=E'1'             1
         STE    F0,TMP(R1)           tmp(i,i+n)=1
         LA     R6,1(R6)             i++
       ENDDO    ,                  enddo i
         LA     R6,1               i=1
       DO  WHILE=(C,R6,LE,N)       do r=1 to n
         LR     R1,R6                r
         BCTR   R1,0                 -1
         MH     R1,HN2               *n*2
         LR     R0,R6                r
         BCTR   R0,0                 -1
         AR     R1,R0                (r-1)*n*2+r-1
         SLA    R1,2                 *4
         LE     F0,TMP(R1)           tmp(r,r)
         STE    F0,T                 t=tmp(r,r)
         LA     R7,1                 c=1 
       DO WHILE=(C,R7,LE,N2)         do c=1 to n*2
         LR     R1,R6                  r
         BCTR   R1,0
         MH     R1,HN2
         LR     R0,R7                  c
         BCTR   R0,0
         AR     R1,R0
         SLA    R1,2
         LE     F0,TMP(R1)
         LTER   F0,F0
         BZ     *+8
         DE     F0,T                   tmp(r,c)/t
         LR     R1,R6                  r
         BCTR   R1,0
         MH     R1,HN2
         LR     R0,R7                  c
         BCTR   R0,0
         AR     R1,R0
         SLA    R1,2
         STE    F0,TMP(R1)             tmp(r,c)=tmp(r,c)/t
         LA     R7,1(R7)               c++
       ENDDO    ,                    enddo c
         LA     R8,1                   i=1 
       DO WHILE=(C,R8,LE,N)            do i=1 to n
       IF    CR,R8,NE,R6 THEN            if i^=r then
         LR     R1,R8                      i                    
         BCTR   R1,0
         MH     R1,HN2
         LR     R0,R6                      r
         BCTR   R0,0
         AR     R1,R0
         SLA    R1,2
         LE     F0,TMP(R1)                 tmp(i,r)
         STE    F0,T                       t=tmp(i,r)
         LA     R7,1                       c=1 
       DO WHILE=(C,R7,LE,N2)               do c=1 to n*2
         LR     R2,R8                        i
         BCTR   R2,0
         MH     R2,HN2
         LR     R0,R7                        c
         BCTR   R0,0
         AR     R2,R0
         SLA    R2,2
         LE     F0,TMP(R2)                   f0=tmp(i,c)
         LR     R1,R6                        r
         BCTR   R1,0
         MH     R1,HN2
         LR     R0,R7                        c
         BCTR   R0,0
         AR     R1,R0
         SLA    R1,2
         LE     F2,TMP(R1)                   f2=tmp(r,c)
         LE     F4,T                         t
         MER    F4,F2                        f4=t*tmp(r,c)
         SER    F0,F4                        f0=tmp(i,c)-t*tmp(r,c)
         STE    F0,TMP(R2)                   tmp(i,c)=f0
         LA     R7,1(R7)                     c++
       ENDDO    ,                          enddo c
       ENDIF    ,                        endif
         LA     R8,1(R8)                 i++
       ENDDO    ,                      enddo i
         LA     R6,1(R6)             r++
       ENDDO    ,                  enddo r
         LA     R6,1               i=1 
       DO WHILE=(C,R6,LE,N)        do i=1 to n
         L      R7,N                 n
         LA     R7,1(R7)             j=n+1 
       DO WHILE=(C,R7,LE,N2)       do j=n+1 to 2*n
         LR     R2,R7                  j
         S      R2,N                   -n
         LR     R1,R6                  i
         BCTR   R1,0
         MH     R1,HN2                 *2*n
         LR     R0,R7                  j
         BCTR   R0,0
         AR     R1,R0
         SLA    R1,2
         LE     F0,TMP(R1)             tmp(i,j)
         LR     R1,R6                  i
         BCTR   R1,0
         MH     R1,HN                  *n
         BCTR   R2,0
         AR     R1,R2
         SLA    R1,2
         STE    F0,BB(R1)              bb(i,j-n)=tmp(i,j)
         LA     R7,1(R7)               j++
       ENDDO    ,                    enddo j
         LA     R6,1(R6)             i++ 
       ENDDO    ,                  enddo i
         LA     R6,1               i=1 
       DO WHILE=(C,R6,LE,N)        do i=1 to n
         LA     R3,PG                @pg
         LA     R7,1                 j=1 
       DO WHILE=(C,R7,LE,N)          do j=1 to n
         LR     R1,R6                  i
         BCTR   R1,0
         MH     R1,HN                  *n
         LR     R0,R7                  j
         BCTR   R0,0
         AR     R1,R0
         SLA    R1,2
         LE     F0,BB(R1)              bb(i,j) 
         LA     R0,5                   number of decimals
         BAL    R14,FORMATF            FormatF(bb(i,j))
         MVC    0(13,R3),0(R1)         edit
         LA     R3,13(R3)              @pg+=13
         LA     R7,1(R7)               j++
       ENDDO    ,                    enddo j
         XPRNT  PG,L'PG              print buffer
         LA     R6,1(R6)             i++ 
       ENDDO    ,                  enddo i
         L      R13,4(0,R13)       restore previous savearea pointer
         RETURN (14,12),RC=0       restore registers from calling save
         COPY   plig\$_FORMATF.MLC format a float
NN       EQU    5
N        DC     A(NN)
N2       DC     A(NN*2)
AA       DC     E'3.0',E'1.0',E'5.0',E'9.0',E'7.0'
         DC     E'8.0',E'2.0',E'8.0',E'0.0',E'1.0'
         DC     E'1.0',E'7.0',E'2.0',E'0.0',E'3.0'
         DC     E'0.0',E'1.0',E'7.0',E'0.0',E'9.0'
         DC     E'3.0',E'5.0',E'6.0',E'1.0',E'1.0'
BB       DS     (NN*NN)E
TMP      DS     (NN*NN*2)E
T        DS     E
HN       DC     AL2(NN)
HN2      DC     AL2(NN*2)
PG       DC     CL80' '            buffer
         REGEQU
         END    GAUSSJOR 