*        Floyd-Warshall algorithm - 06/06/2018
FLOYDWAR CSECT
         USING  FLOYDWAR,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
         MVC    A+8,=F'-2'         a(1,3)=-2
         MVC    A+VV*4,=F'4'       a(2,1)= 4
         MVC    A+VV*4+8,=F'3'     a(2,3)= 3
         MVC    A+VV*8+12,=F'2'    a(3,4)= 2
         MVC    A+VV*12+4,=F'-1'   a(4,2)=-1
         LA     R8,1               k=1
       DO WHILE=(C,R8,LE,V)        do k=1 to v
         LA     R10,A                @a
         LA     R6,1                 i=1
       DO WHILE=(C,R6,LE,V)          do i=1 to v
         LA     R7,1                   j=1
       DO WHILE=(C,R7,LE,V)            do j=1 to v
         LR     R1,R6                    i
         BCTR   R1,0
         MH     R1,=AL2(VV)
         AR     R1,R8                    k
         SLA    R1,2
         L      R9,A-4(R1)               a(i,k)
         LR     R1,R8                    k
         BCTR   R1,0
         MH     R1,=AL2(VV)
         AR     R1,R7                    j
         SLA    R1,2
         L      R3,A-4(R1)               a(k,j)
         AR     R9,R3                    w=a(i,k)+a(k,j)
         L      R2,0(R10)                a(i,j)
       IF CR,R2,GT,R9 THEN               if a(i,j)>w then
         ST     R9,0(R10)                  a(i,j)=w
       ENDIF    ,                        endif
         LA     R10,4(R10)               next @a
         LA     R7,1(R7)                 j++
       ENDDO    ,                      enddo j
         LA     R6,1(R6)               i++
       ENDDO    ,                    enddo i
         LA     R8,1(R8)             k++
       ENDDO    ,                  enddo k
         LA     R10,A              @a
         LA     R6,1               f=1
       DO WHILE=(C,R6,LE,V)        do f=1 to v
         LA     R7,1                 t=1
       DO WHILE=(C,R7,LE,V)          do t=1 to v
       IF CR,R6,NE,R7 THEN             if f^=t then do
         LR     R1,R6                    f
         XDECO  R1,XDEC                  edit f
         MVC    PG+0(4),XDEC+8           output f
         LR     R1,R7                    t
         XDECO  R1,XDEC                  edit t
         MVC    PG+8(4),XDEC+8           output t
         L      R2,0(R10)                a(f,t)
         XDECO  R2,XDEC                  edit a(f,t)
         MVC    PG+12(4),XDEC+8          output a(f,t)
         XPRNT  PG,L'PG                  print
       ENDIF    ,                      endif
         LA     R10,4(R10)             next @a
         LA     R7,1(R7)               t++
       ENDDO    ,                    enddo t
         LA     R6,1(R6)             f++
       ENDDO    ,                  enddo f
         L      R13,4(0,R13)       restore previous savearea pointer
         RETURN (14,12),RC=0       restore registers from calling sav
VV       EQU    4
V        DC     A(VV)
A        DC     (VV*VV)F'99999999' a(vv,vv)
PG       DC     CL80'   . ->    .   .'
XDEC     DS     CL12
         YREGS
         END    FLOYDWAR