Simultaneous Linear Equations 1130 Fortran

1442 Card Deck for JOB

// JOB
// DUP
*DELETE SIMEQ
// FOR
*IOCS (CARD,1132 PRINTER)
*ONE WORD INTEGERS
*EXTENDED PRECISION
*LIST ALL
C ----------------------------------------------------
C
C SIMULATION OF FORTRAN PROGRAM
C RUNNING UNDER 1130 DISK MONITOR RELEASE 2 VERSION 12
C ON WINDOWS 10
C
C SOLUTION OF SET OF SIMULTANEOUS LINEAR EQUATIONS
C USING EITHER
C JORDAN METHOD
C OR GAUSS-SIEDEL METHOD
C
C ROGER K. SIMPSON
C PROGRAM WRITTEN NOV 15, 2010
C
C PROGRAM RESURRECTED AND RUN AGAIN OCT 27, 2016
C
C ----------------------------------------------------
C *** TYPE STATEMENTS
REAL CONS,TOLER,TRM
REAL MULT,OLDPV,SUM,COEFF,SOLN
INTEGER NEQU,NROW,NCOL,IROW,COL,IN,OUT,S,T,U,V
INTEGER CWZ,Q
INTEGER TERMF,ORDR,METHD,K
INTEGER KROW,KCOL,SOLCL,ITER
REAL A(20,21)
REAL B(20,21)
REAL SOLTN(20)
REAL SOLNX(20)
INTEGER DDROW(20)
C *** LOGICAL FILE NUMBERS
C 1442=2 1132=3
IN=2
OUT=3
C **********************************
C READ IN DATA
C **********************************
METHD = 1
GO TO (15,18), METHD
15 WRITE (OUT,4)
GO TO 20
18 WRITE (OUT,5)
C -- GET ORDER OF SIMULTANEOUS LINEAR EQUATION SYSTEM
C NEQU IS THE NUMBER OF ROWS IN THE
C INPUT MATRIX.
C NEQU MUST BE IN RANGE OF 16 TO 20
20 READ (IN, 1) NEQU
C -- SETUP NUMBER OF ROWS AND COLUMNS IN MATRIX
NROW = NEQU
NCOL = NROW + 1
C -- POPULATE THE MATRIX
DO 30 IROW = 1, NROW
READ (IN,2) (A(IROW,COL), COL = 1,6)
READ (IN,2) (A(IROW,COL), COL = 7,12)
READ (IN,2) (A(IROW,COL), COL = 13,18)
READ (IN,2) (A(IROW,COL), COL = 19,20)
30 CONTINUE
C ***********************************
C COPY ARRAY A TO ARRAY B
C ***********************************
DO 70 IROW = 1,NROW
DO 75 COL = 1,NCOL
75 B(IROW,COL) = A(IROW,COL)
70 CONTINUE
C ***********************************
C EITHER RUN GAUSS-JORDAN ELIMINATION
C METHOD
C OR GAUSS-JORDAN ITERATIVE METHOD
C METHD = 1 IS JORDAN
C METHD = 2 IS GAUSS-SIEDEL
C ***********************************
GO TO (100,810), METHD
C ***********************************
C PERFORM JORDAN METHOD
C ***********************************
100 DO 800 S=1,NROW
C --- (A) ADJUST 'CURRENT ROW' SO PIVOT VALUE IS 1
DO 200 T=S,COL
IF (T-S) 150,125,150
C SET PIVOT VALUE TO 1
125 OLDPV = A(S,T)
A(S,T) = 1.0
GO TO 200
C NORMALIZE ALL COEFFICIENTS IN CURRENT ROW AS
C REQUIRED SINCE THE PIVOT VALUE WAS SET TO ONE
150 A(S,T) = A(S,T) / OLDPV
200 CONTINUE
C --- (B) ADJUST ALL COEFFICIENTS IN ALL ROWS BESIDES
C THE CURRENT ROW
C 1. THE COEFFICIENT OF THE PIVOT COLUMN IS NOW 0
C 2. MODIFY ALL COEFFICIENTS IN OTHER ROWS AS
C REQUIRED SINCE THE COEFFICIENT IN THE
C PIVOT COLUMN IS NOW ZERO
DO 750 U=1, NROW
IF (U-S) 240, 720, 240
C THIS IS A ROW WE HAVE TO WORK ON
240 CWZ = S
DO 700 V=CWZ,NCOL
IF (V-CWZ) 260,250,260
250 MULT= A(U,V)
A(U,V) = 0.0
GO TO 700
260 A(U,V) = A(U,V) - (MULT * A(S,V))
700 CONTINUE
720 CONTINUE
750 CONTINUE
800 CONTINUE
C ---- MOVE SOLUTION TO 'SOLTN' ARRAY
SOLCL = NEQU+1
DO 805 Q=1,NEQU
805 SOLTN(Q) = A(Q, SOLCL)
GO TO 890
C ***********************************
C GAUSS - SEIDEL ITERATIVE METHOD
C ***********************************
810 ORDR = NEQU
TERMF = 0
ITER = 0
TOLER = 1.0001
C === A. DETERMINE IF MATRIX IS DIAGONALLY DOMINANT
DO 600 KROW=1,ORDR
C --- AT THE OUTSET I ASSUME ROW IS NOT DIAGONALLY
C DOMINANT
DDROW(KROW) = 0
DIAG = A(KROW,KROW)
SUM = 0.0
DO 610 KCOL=1,ORDR
IF (KCOL-KROW) 605,610,605
605 TRM = ABS(A(KROW,KCOL))
SUM = SUM + TRM
610 CONTINUE
C ---- DETERMINE IF THIS ROW MEETS CRITERION FOR
C DIAGONAL DOMINANCE
IF (DIAG-SUM) 600,600,620
C -- THIS ROW IS DIAGONALLY DOMINANT
620 DDROW(KROW) = 1
600 CONTINUE
C ---- IN ORDER FOR THE MATRIX TO BE DIAGONALLY DOMINANT
C THE CRITERION FOR EACH ROW MUST BE MET
C --- INITIALLY I ASSUME MATRIX IS DIAGONALLY DOMINANT
DIAGC = 1
DO 630 KROW=1,ORDR
ROWC = DDROW(KROW)
IF (ROWC) 625,625,630
C --- MATRIX CAN'T BE DIAGONALLY DOMINANT BECAUSE
C THIS ROW DOES NOT MEET CRITERION
625 DIAGC = 0
630 CONTINUE
IF (DIAGC) 634,634,632
632 WRITE (OUT,1005)
GO TO 812
C --- BECAUSE MATRIX IS NOT DIAGONALLY DOMINANT
C I CAN'T PERFORM THE GAUSS-SIEDEL METHOD
634 WRITE (OUT,1006)
GO TO 950
C === B. INITIALIZE SOLUTION MATRIX TO ZERO
812 DO 813 KROW=1,ORDR
813 SOLTN(KROW) = 0.0
C === C. PERFORM ITERATION
C -- BEGIN DO LOOP 1 (OUTER LOOP)
815 DO 850 KROW=1,ORDR
SUM = 0.0
C -- BEGIN DO LOOP 2 (INNER LOOP)
DO 830 KCOL=1,ORDR
IF (KROW-KCOL) 820,830,820
820 COEFF = -A(KROW,KCOL)
SUM = SUM + (COEFF * SOLTN(KCOL))
830 CONTINUE
C -- END DO LOOP 2
K = ORDR+1
CONS = A(KROW, K)
SOLN = (SUM + CONS) / A(KROW, KROW)
SOLNX(KROW) = SOLN
C WRITE(OUT,1002) SOLN
850 CONTINUE
C -- END DO LOOP 1
ITER=ITER+1
C --- DETERMINE IF SOLUTION HAS CONVERGED
TERMF = 1
C -- BEGIN DO LOOP 3
DO 880 KROW=1,ORDR
RATIO = SOLTN(KROW) / SOLNX(KROW)
C WRITE (OUT,1001) RATIO
C --- IF NUMBER 1
IF (RATIO-0.0000001) 852,852,860
852 TERMF = 0
GO TO 880
C --- ELSE NUMBER 1
C -- IF NUMBER 2
860 IF(RATIO-1.0) 865,868,868
C -- IF RATIO .LT. 1.0 THEN
C SET RATIO TO RECIPROCAL OF
C RATIO
865 RATIO = 1.0 / RATIO
C -- ENDIF NUMBER 2
C -- IF NUMBER 3
868 IF(RATIO-TOLER) 880,880,869
C -- IF RATIO IS .GT. TOLERANCE THEN DONT
C TERMINATE
869 TERMF=0
C -- ENDIF NUMBER 3
C -- ENDIF NUMBER 1
880 CONTINUE
C -- END DO LOOP 3
C
C --- PREPARE FOR NEXT ITERATION BY
C COPYING NEXT SOLUTION 'SOLNX' TO
C SOLUTION 'SOLTN'
C --- BEGIN DO LOOP 4
DO 885 KROW=1,ORDR
885 SOLTN(KROW) = SOLNX(KROW) C --- END DO LOOP 4
IF (TERMF) 815,815,887
C --- PRINT OUT NUMBER OF ITERATIONS
887 WRITE (OUT,1003) ITER
C ***********************************
C DISPLAY SOLUTION
C ***********************************
890 WRITE (OUT,6)
DO 900 Q=1,NEQU
900 WRITE (OUT,8) Q, SOLTN(Q)
C ***********************************
C CHECK THE SOLUTION
C ***********************************
WRITE (OUT,9)
DO 910 KROW=1,NEQU
SUM = 0.0
DO 920 KCOL=1,NEQU
920 SUM = SUM + (SOLTN(KCOL) * B(KROW,KCOL))
910 WRITE (OUT,10) KROW, SUM
950 STOP 16
C ***
C ***
C *** FORMAT STATEMENTS
C ***
C --- INPUT
1 FORMAT(I6)
2 FORMAT(6F11.0) C --- OUTPUT
4 FORMAT (2X,'JORDAN METHOD -- RK SIMPSON -- OCT 2016')
5 FORMAT (2X,'GAUSS SIEDEL METHOD -- RK SIMPSON -- OCT 2016')
6 FORMAT (/2X,'RESULT -- ')
8 FORMAT (2X,'X( ',I2,' )= ',F10.4)
9 FORMAT (/2X,'CHECK --- ')
10 FORMAT (2X,'C( ',I2,' )= ',F10.4)
1003 FORMAT (2x,'NUMBER OF ITERATIONS = ',I4)
1005 FORMAT (2X,'MATRIX IS DIAGNALLY DOMINANT')
1006 FORMAT (2X,'MATRIX IS NOT DIAGNALLY DOMINANT')
END
// DUP
*STORE WS UA SIMEQ
// XEQ SIMEQ L
19
+1533.9910 +0006.6848 +0015.9037 -0042.0875 -0039.6104 +0054.9480
-0097.1965 +0052.1447 +0062.8980 +0041.8076 -0090.9295 -0017.1935
+0072.5239 +0058.0960 -0025.2928 +0092.3906 +0074.2892 -0088.7526
+0089.9113 -0027.1963
+0004.9737 +1310.7860 -0089.2991 +0018.4917 -0006.2600 -0040.3669
+0024.5393 +0029.5642 -0047.2414 -0044.1316 +0065.9603 +0064.9204
+0017.8326 +0097.2186 +0082.1929 -0054.6268 +0039.0231 +0096.0007
-0051.2137 +0006.7746
-0078.7261 +0099.8829 +1699.4800 -0096.8592 +0015.0368 -0079.9896
-0079.3955 +0059.7769 -0043.1040 -0090.8702 -0040.8454 -0023.5979
-0039.8059 +0089.7142 +0095.9659 -0019.7251 -0044.3440 -0067.9117
-0067.4357 +0029.3174
-0017.9854 -0017.4466 +0042.5461 +1105.6440 +0026.6358 -0058.4878
-0062.7973 +0016.6718 -0083.8571 -0008.4057 +0081.1460 -0047.7264
+0057.0424 -0024.2195 -0042.0670 +0083.8754 +0026.3485 +0025.5284
-0014.3087 -0080.4052
+0012.2080 +0038.8971 +0082.7435 +0066.9634 +1156.5500 +0008.6721
+0083.2328 -0013.9478 +0035.5895 +0000.4908 +0002.7475 -0007.4040
-0029.3055 -0019.0332 -0046.0537 -0088.8813 -0051.2310 +0095.8156
-0087.8168 -0021.9417
-0027.0009 -0002.0211 -0068.8674 -0005.1082 -0048.5465 +1119.8650
+0008.4140 -0068.7396 +0087.7090 +0030.8999 +0001.2175 -0021.9057
-0078.5249 +0056.7991 -0008.0718 +0050.7376 +0019.2189 +0066.5460
-0096.2483 -0057.9263
-0085.2093 -0078.9095 -0033.6611 -0074.3500 -0099.9518 +0007.3588
+1435.8800 +0008.8028 +0065.4824 -0083.6213 -0061.6155 +0035.7827
-0009.1584 -0028.5954 -0070.0038 +0040.8792 +0085.7572 +0006.0425
-0082.0717 +0051.5459
-0019.6316 -0007.6251 -0001.5669 -0058.4745 -0034.0528 -0080.9142
+0017.9585 +1308.1370 +0085.5233 -0080.4140 -0011.2275 -0045.4106
+0074.5094 +0050.1375 -0045.4115 +0034.7293 -0048.6742 -0082.0207
-0093.8099 -0035.4565
+0058.0258 -0040.5484 -0052.9436 -0003.9051 -0049.0796 -0031.8787
-0091.0132 -0003.5144 +1231.9470 +0072.9069 +0017.7257 +0050.9817
+0085.5766 -0033.7966 +0008.5882 -0083.8617 +0026.8744 -0017.9927
+0092.0846 -0077.0753
+0084.6890 +0024.0419 -0030.4547 -0070.1509 -0004.0043 -0056.1182
+0098.7463 -0073.9159 -0094.2229 +1454.6200 +0009.5337 +0084.5909
+0007.6493 -0018.7157 +0069.4491 +0065.2451 +0034.4855 +0044.3790
+0099.3543 -0032.0388
-0000.9577 -0017.4064 +0039.0564 -0064.1821 -0015.4164 +0008.6354
+0062.9328 +0008.1827 -0014.4933 +0001.8136 +0823.7910 +0023.8375
-0002.0339 +0036.1639 +0077.3200 -0025.8969 -0039.5005 -0041.4266
-0069.9377 +0005.9642
-0055.3476 +0016.9059 -0027.3083 +0075.1949 -0004.3972 -0061.8733
+0036.8125 +0049.4832 +0022.7870 +0056.4277 -0067.6513 +1334.3170
-0059.4763 +0091.3525 -0086.8298 -0087.6956 +0058.6395 -0024.0791
-0007.2832 -0076.0912
-0076.9060 -0065.2453 -0090.3762 +0042.9633 +0006.6045 +0012.2019
-0056.6533 -0006.3989 +0049.2710 +0050.4622 -0020.2135 +0080.6198
+1259.9430 -0082.2881 +0026.9142 +0042.6056 -0096.8635 -0013.7711
-0019.6035 -0044.9409
+0097.0748 +0060.5175 +0039.2202 -0016.4802 +0046.8976 -0044.5663
-0028.6827 -0013.3086 +0088.9942 -0075.6900 +0029.1903 -0030.4335
-0079.1135 +1274.1980 -0084.4631 -0013.4481 +0091.8542 +0008.4059
-0001.1247 +0094.5933
-0056.4400 -0024.2018 -0020.8311 -0043.6993 +0000.6742 -0072.2535
+0003.4512 +0093.0729 +0011.5002 +0081.8408 +0031.4513 -0011.7771
+0038.5989 -0087.1018 +1112.6220 +0040.1029 -0000.5858 -0068.9129
-0055.2525 -0034.7712
+0056.8977 -0089.9474 +0003.6032 +0051.4059 +0060.1340 -0034.9589
+0094.5458 +0060.8534 +0034.9652 +0081.0259 +0075.1559 -0016.6703
-0075.3834 +0090.8316 +0059.4595 +1603.0580 -0019.6791 -0096.7405
-0066.4474 -0067.1532
+0001.9440 -0018.7875 -0078.7733 -0044.7753 +0028.6094 +0069.8200
-0000.4062 -0062.4450 +0079.3233 -0025.4371 -0035.2890 +0054.1666
-0056.3999 -0010.6014 -0052.7945 +0075.6769 +1113.6940 -0025.1136
-0022.0996 +0072.1179
+0017.1876 +0086.3119 +0003.4385 -0033.9398 +0073.6907 -0048.1878
-0048.0917 -0064.2613 -0030.6086 -0099.4989 +0048.4684 +0068.1774
-0044.2821 +0040.5940 -0019.0271 +0062.3143 +0048.3561 +1381.2600
-0084.4039 -0017.8737
-0032.1250 +0042.1109 -0037.5424 +0059.7547 -0069.6488 +0018.5983
+0091.2474 -0051.3704 +0087.9942 -0077.1334 +0096.8507 +0026.5952
+0019.7713 +0080.5139 +0014.9730 -0050.9652 +0072.0325 -0085.0099
+1521.3550 +0051.9958

1132 Listing -- [output of JOB]

PAGE 1
// JOB
LOG DRIVE CART SPEC CART AVAIL PHY DRIVE
0000 1234 1234 0000 V2 M12 ACTUAL 16K CONFIG 16K
// DUP
*DELETE SIMEQ
CART ID 1234 DB ADDR 216A DB CNT 0046
// FOR
*IOCS (CARD,1132 PRINTER)
*ONE WORD INTEGERS
*EXTENDED PRECISION
*LIST ALL
C ----------------------------------------------------
C
C SIMULATION OF 1130 DISK MONITOR RELEASE 2 VERSION 12
C ON WINDOWS 10
C
C SOLUTION OF SET OF SIMULTANEOUS LINEAR EQUATIONS
C USING EITHER
C JORDAN METHOD
C OR GAUSS-SIEDEL METHOD
C
C ROGER K. SIMPSON
C PROGRAM WRITTEN NOV 15, 2010
C
C PROGRAM RESURRECTED AND RUN AGAIN OCT 27, 2016
C
C
C ----------------------------------------------------
C *** TYPE STATEMENTS
REAL CONS,TOLER,TRM
REAL MULT,OLDPV,SUM,COEFF,SOLN
INTEGER NEQU,NROW,NCOL,IROW,COL,IN,OUT,S,T,U,V
INTEGER CWZ,Q INTEGER TERMF,ORDR,METHD,K INTEGER KROW,KCOL,SOLCL,ITER REAL A(20,21) REAL B(20,21) REAL SOLTN(20) REAL SOLNX(20) INTEGER DDROW(20) C *** LOGICAL FILE NUMBERS C 1442=2 1132=3 IN=2
OUT=3
C **********************************
C READ IN DATA
C **********************************
METHD = 1
GO TO (15,18), METHD
15 WRITE (OUT,4)
GO TO 20
18 WRITE (OUT,5)
C -- GET ORDER OF SIMULTANEOUS LINEAR EQUATION SYSTEM

PAGE 2

C NEQU IS THE NUMBER OF ROWS IN THE
C INPUT MATRIX.
C NEQU MUST BE IN RANGE OF 16 TO 20
20 READ (IN, 1) NEQU
C -- SETUP NUMBER OF ROWS AND COLUMNS IN MATRIX
NROW = NEQU
NCOL = NROW + 1
C -- POPULATE THE MATRIX
DO 30 IROW = 1, NROW
READ (IN,2) (A(IROW,COL), COL = 1,6)
READ (IN,2) (A(IROW,COL), COL = 7,12)
READ (IN,2) (A(IROW,COL), COL = 13,18)
READ (IN,2) (A(IROW,COL), COL = 19,20)
30 CONTINUE
C ***********************************
C COPY ARRAY A TO ARRAY B
C ***********************************
DO 70 IROW = 1,NROW
DO 75 COL = 1,NCOL
75 B(IROW,COL) = A(IROW,COL)
70 CONTINUE
C ***********************************
C EITHER RUN GAUSS-JORDAN ELIMINATION
C METHOD
C OR GAUSS-JORDAN ITERATIVE METHOD
C METHD = 1 IS JORDAN
C METHD = 2 IS GAUSS-SIEDEL
C ***********************************
GO TO (100,810), METHD
C ***********************************
C PERFORM JORDAN METHOD
C ***********************************
100 DO 800 S=1,NROW
C --- (A) ADJUST 'CURRENT ROW' SO PIVOT VALUE IS 1
DO 200 T=S,COL
IF (T-S) 150,125,150
C SET PIVOT VALUE TO 1
125 OLDPV = A(S,T)
A(S,T) = 1.0
GO TO 200
C NORMALIZE ALL COEFFICIENTS IN CURRENT ROW AS
C REQUIRED SINCE THE PIVOT VALUE WAS SET TO ONE
150 A(S,T) = A(S,T) / OLDPV
200 CONTINUE
C --- (B) ADJUST ALL COEFFICIENTS IN ALL ROWS BESIDES
C THE CURRENT ROW
C 1. THE COEFFICIENT OF THE PIVOT COLUMN IS NOW 0
C 2. MODIFY ALL COEFFICIENTS IN OTHER ROWS AS
C REQUIRED SINCE THE COEFFICIENT IN THE
C PIVOT COLUMN IS NOW ZERO
DO 750 U=1, NROW
IF (U-S) 240, 720, 240
C THIS IS A ROW WE HAVE TO WORK ON
240 CWZ = S
DO 700 V=CWZ,NCOL
IF (V-CWZ) 260,250,260
250 MULT= A(U,V)
A(U,V) = 0.0
GO TO 700

PAGE 3

260 A(U,V) = A(U,V) - (MULT * A(S,V))
700 CONTINUE
720 CONTINUE
750 CONTINUE
800 CONTINUE
C ---- MOVE SOLUTION TO 'SOLTN' ARRAY
SOLCL = NEQU+1
DO 805 Q=1,NEQU
805 SOLTN(Q) = A(Q, SOLCL)
GO TO 890
C ***********************************
C GAUSS - SEIDEL ITERATIVE METHOD
C ***********************************
810 ORDR = NEQU
TERMF = 0
ITER = 0
TOLER = 1.0001
C === A. DETERMINE IF MATRIX IS DIAGONALLY DOMINANT
DO 600 KROW=1,ORDR
C --- AT THE OUTSET I ASSUME ROW IS NOT DIAGONALLY
C DOMINANT
DDROW(KROW) = 0
DIAG = A(KROW,KROW)
SUM = 0.0
DO 610 KCOL=1,ORDR
IF (KCOL-KROW) 605,610,605
605 TRM = ABS(A(KROW,KCOL))
SUM = SUM + TRM
610 CONTINUE
C ---- DETERMINE IF THIS ROW MEETS CRITERION FOR
C DIAGONAL DOMINANCE
IF (DIAG-SUM) 600,600,620
C -- THIS ROW IS DIAGONALLY DOMINANT
620 DDROW(KROW) = 1
600 CONTINUE
C ---- IN ORDER FOR THE MATRIX TO BE DIAGONALLY DOMINANT
C THE CRITERION FOR EACH ROW MUST BE MET
C --- INITIALLY I ASSUME MATRIX IS DIAGONALLY DOMINANT
DIAGC = 1
DO 630 KROW=1,ORDR
ROWC = DDROW(KROW)
IF (ROWC) 625,625,630
C --- MATRIX CAN'T BE DIAGONALLY DOMINANT BECAUSE
C THIS ROW DOES NOT MEET CRITERION
625 DIAGC = 0
630 CONTINUE
IF (DIAGC) 634,634,632
632 WRITE (OUT,1005)
GO TO 812
C --- BECAUSE MATRIX IS NOT DIAGONALLY DOMINANT
C I CAN'T PERFORM THE GAUSS-SIEDEL METHOD
634 WRITE (OUT,1006)
GO TO 950
C === B. INITIALIZE SOLUTION MATRIX TO ZERO
812 DO 813 KROW=1,ORDR
813 SOLTN(KROW) = 0.0
C === C. PERFORM ITERATION
C -- BEGIN DO LOOP 1 (OUTER LOOP)
815 DO 850 KROW=1,ORDR

PAGE 4

SUM = 0.0
C -- BEGIN DO LOOP 2 (INNER LOOP) DO 830 KCOL=1,ORDR
IF (KROW-KCOL) 820,830,820
820 COEFF = -A(KROW,KCOL)
SUM = SUM + (COEFF * SOLTN(KCOL))
830 CONTINUE
C -- END DO LOOP 2
K = ORDR+1
CONS = A(KROW, K)
SOLN = (SUM + CONS) / A(KROW, KROW)
SOLNX(KROW) = SOLN
C WRITE(OUT,1002) SOLN
850 CONTINUE
C -- END DO LOOP 1
ITER=ITER+1
C --- DETERMINE IF SOLUTION HAS CONVERGED
TERMF = 1
C -- BEGIN DO LOOP 3
DO 880 KROW=1,ORDR
RATIO = SOLTN(KROW) / SOLNX(KROW)
C WRITE (OUT,1001) RATIO
C --- IF NUMBER 1
IF (RATIO-0.0000001) 852,852,860
852 TERMF = 0
GO TO 880
C --- ELSE NUMBER 1
C -- IF NUMBER 2
860 IF(RATIO-1.0) 865,868,868
C -- IF RATIO .LT. 1.0 THEN
C SET RATIO TO RECIPROCAL OF
C RATIO
865 RATIO = 1.0 / RATIO
C -- ENDIF NUMBER 2
C -- IF NUMBER 3
868 IF(RATIO-TOLER) 880,880,869
C -- IF RATIO IS .GT. TOLERANCE THEN DONT
C TERMINATE
869 TERMF=0
C -- ENDIF NUMBER 3
C -- ENDIF NUMBER 1
880 CONTINUE
C -- END DO LOOP 3
C
C
C --- PREPARE FOR NEXT ITERATION BY
C COPYING NEXT SOLUTION 'SOLNX' TO
C SOLUTION 'SOLTN'
C --- BEGIN DO LOOP 4
DO 885 KROW=1,ORDR
885 SOLTN(KROW) = SOLNX(KROW)
C --- END DO LOOP 4
IF (TERMF) 815,815,887
C --- PRINT OUT NUMBER OF ITERATIONS
887 WRITE (OUT,1003) ITER
C ***********************************
C DISPLAY SOLUTION
C ***********************************
890 WRITE (OUT,6)

PAGE 5

DO 900 Q=1,NEQU
900 WRITE (OUT,8) Q, SOLTN(Q)
C ***********************************
C CHECK THE SOLUTION
C ***********************************
WRITE (OUT,9)
DO 910 KROW=1,NEQU
SUM = 0.0
DO 920 KCOL=1,NEQU
920 SUM = SUM + (SOLTN(KCOL) * B(KROW,KCOL))
910 WRITE (OUT,10) KROW, SUM
950 STOP 16
C ***
C ***
C *** FORMAT STATEMENTS
C ***
C --- INPUT
1 FORMAT(I6)
2 FORMAT(6F11.0)
C --- OUTPUT
4 FORMAT (2X,'JORDAN METHOD -- RK SIMPSON -- OCT 2016')
5 FORMAT (2X,'GAUSS SIEDEL METHOD -- RK SIMPSON -- OCT 2016')
6 FORMAT (/2X,'RESULT -- ')
8 FORMAT (2X,'X( ',I2,' )= ',F10.4)
9 FORMAT (/2X,'CHECK --- ')

10 FORMAT (2X,'C( ',I2,' )= ',F10.4)
1003 FORMAT (2X,'NUMBER OF ITERATIONS = ',I4)
1005 FORMAT (2X,'MATRIX IS DIAGNALLY DOMINANT')
1006 FORMAT (2X,'MATRIX IS NOT DIAGNALLY DOMINANT')
END
VARIABLE ALLOCATIONS
CONS(R )=0000 TOLER(R )=0003 TRM(R )=0006 MULT(R )=0009 OLDPV(R )=000C SUM(R )=000F
COEFF(R )=0012 SOLN(R )=0015 A(R )=0501-0018 B(R )=09ED-0504 SOLTN(R )=0A29-09F0 SOLNX(R )=0A65-0A2C
DIAG(R )=0A68 DIAGC(R )=0A6B ROWC(R )=0A6E RATIO(R )=0A71 NEQU(I )=0A74 NROW(I )=0A75
NCOL(I )=0A76 IROW(I )=0A77 COL(I )=0A78 IN(I )=0A79 OUT(I )=0A7A S(I )=0A7B
T(I )=0A7C U(I )=0A7D V(I )=0A7E CWZ(I )=0A7F Q(I )=0A80 TERMF(I )=0A81
ORDR(I )=0A82 METHD(I )=0A83 K(I )=0A84 KROW(I )=0A85 KCOL(I )=0A86 SOLCL(I )=0A87
ITER(I )=0A88 DDROW(I )=0A9C-0A89

STATEMENT ALLOCATIONS
1 =0AB9 2 =0ABB 4 =0ABE 5 =0AD5 6 =0AEF 8 =0AF8 9 =0B02 10 =0B0B 1003 =0B15 1005 =0B25
1006 =0B36 15 =0B72 18 =0B78 20 =0B7C 30 =0BEF 75 =0C00 70 =0C14 100 =0C23 125 =0C31 150 =0C44
200 =0C51 240 =0C64 250 =0C72 260 =0C85 700 =0C9D 720 =0CA6 750 =0CA6 800 =0CAF 805 =0CC2 810 =0CDF
605 =0D15 610 =0D2C 620 =0D3C 600 =0D45 625 =0D66 630 =0D6B 632 =0D79 634 =0D7F 812 =0D85 813 =0D89
815 =0D9B 820 =0DAD 830 =0DC6 850 =0DF8 852 =0E21 860 =0E27 865 =0E2E 868 =0E34 869 =0E3B 880 =0E3F
885 =0E4C 887 =0E62 890 =0E68 900 =0E70 920 =0E96 910 =0EB7 950 =0EC8

FEATURES SUPPORTED
ONE WORD INTEGERS
EXTENDED PRECISION
IOCS

CALLED SUBPROGRAMS
EABS EADD ESUB EMPYX EDIV EDIVX ELD ELDX ESTO ESTOX ESBRX FLOAT CARDZ PRNTZ SRED
SWRT SCOMP SFIO SIOFX SIOF SIOI SUBSC STOP SNR

REAL CONSTANTS
.100000000E 01=0AA0 .000000000E 00=0AA3 .100010000E 01=0AA6 .100000000E-06=0AA9

PAGE 6

INTEGER CONSTANTS
2=0AAC 3=0AAD 1=0AAE 6=0AAF 7=0AB0 12=0AB1 13=0AB2 18=0AB3 19=0AB4 20=0AB5
0=0AB6 16=0AB7 22=0AB8

CORE REQUIREMENTS FOR
COMMON 0 VARIABLES 2720 PROGRAM 1066

END OF COMPILATION

// DUP

*STORE WS UA SIMEQ
CART ID 1234 DB ADDR 21B2 DB CNT 0046

// XEQ SIMEQ L
R 41 24FC (HEX) WDS UNUSED BY CORE LOAD
CALL TRANSFER VECTOR
EABS 17EE
LIBF TRANSFER VECTOR
EBCTB 1A5F
HOLTB 1A23
GETAD 19E0
NORM 19B6
EGETP 19A0
EADDX 180B
XMD 195E
FARC 193C
XDD 18F2
HOLEZ 18BC
PAUSE 18A6
IFIX 187A
STOP 186E
SIOF 11A8
EDIVX 1756
SNR 1866
FLOAT 185C
ESUB 17FA
EADD 1805
ESBRX 17D6
EMPYX 17A8
EDIV 175A
ESTOX 170A
ELDX 1720
SIOFX 11D0
SUBSC 1738
SIOI 11D4
SRED 10CD
SCOMP 11AC
SWRT 10C8
ESTO 170E
ELD 1724
PRNTZ 1622
CARDZ 1572
SFIO 11E9
SYSTEM SUBROUTINES
ILS04 00C4
ILS02 00B3
ILS01 1A64
PAGE 7
ILS00 1A7D
0D47 (HEX) IS THE EXECUTION ADDR

JORDAN METHOD -- RK SIMPSON -- OCT 2016

RESULT --
X( 1 )= -0.0187
X( 2 )= 0.0008
X( 3 )= 0.0078
X( 4 )= -0.0781
X( 5 )= -0.0122
X( 6 )= -0.0508
X( 7 )= 0.0318
X( 8 )= -0.0330
X( 9 )= -0.0605
X( 10 )= -0.0296
X( 11 )= 0.0030
X( 12 )= -0.0656
X( 13 )= -0.0118
X( 14 )= 0.0662
X( 15 )= -0.0263
X( 16 )= -0.0403
X( 17 )= 0.0724
X( 18 )= -0.0182
X( 19 )= 0.0281

CHECK ---
C( 1 )= -27.1962
C( 2 )= 6.7745
C( 3 )= 29.3174
C( 4 )= -80.4052
C( 5 )= -21.9417
C( 6 )= -57.9263
C( 7 )= 51.5459
C( 8 )= -35.4564
C( 9 )= -77.0753
C( 10 )= -32.0387
C( 11 )= 5.9642
C( 12 )= -76.0911
C( 13 )= -44.9409
C( 14 )= 94.5933
C( 15 )= -34.7711
C( 16 )= -67.1532
C( 17 )= 72.1178
C( 18 )= -17.8736
C( 19 )= 51.9958

Updated - October 28, 2016