$JOB SOLN[30,30]
$FORTRAN SOLN
C SOLN 10
C ..................................................................SOLN 20
C SOLN 30
C SAMPLE MAIN PROGRAM - SOLN SOLN 40
C SOLN 50
C PURPOSE SOLN 60
C SOLUTION OF A SET OF SIMULTANEOUS EQUATIONS SOLN 70
C SOLN 80
C SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED SOLN 90
C SIMQ SOLN 100
C MATIN SOLN 110
C MXOUT SOLN 120
C LOC SOLN 130
C SOLN 140
C METHOD SOLN 150
C A MATRIX OF SIMULTANEOUS EQUATIONS COEFFICIENTS AND A VECTORSOLN 160
C OF CONSTANTS ARE READ FROM THE STANDARD INPUT DEVICE. THE SOLN 170
C SOLUTION IS OBTAINED AND LISTED ON THE STANDARD OUTPUT SOLN 180
C DEVICE. THIS PROCEDURE IS REPEATED FOR OTHER SETS OF SOLN 190
C EQUATIONS UNTIL A BLANK CARD IS ENCOUNTERED. SOLN 200
C SOLN 210
C ..................................................................SOLN 220
C SOLN 230
C MATRIX IS DIMENSIONED FOR 2500 ELEMENTS. THEREFORE, NUMBER OF SOLN 240
C EQUATIONS TO BE SOLVED CANNOT EXCEED 50 UNLESS DIMENSION SOLN 250
C STATEMENT IS CHANGED SOLN 260
C SOLN 270
DIMENSION A(2500),B(50) SOLN 280
C SOLN 290
10 FORMAT(1H1,34HSOLUTION OF SIMULTANEOUS EQUATIONS) SOLN 300
11 FORMAT(1H0,44HDIMENSIONED AREA TOO SMALL FOR INPUT MATRIX ,I4) SOLN 310
12 FORMAT(1H0,20HEXECUTION TERMINATED) SOLN 320
13 FORMAT(1H0,47HROW AND COLUMN DIMENSIONS NOT EQUAL FOR MATRIX ,I4) SOLN 330
14 FORMAT(1H0,42HINCORRECT NUMBER OF DATA CARDS FOR MATRIX ,I4) SOLN 340
15 FORMAT(1H0,18HGO ON TO NEXT CASE) SOLN 350
16 FORMAT(1H0,38HSTRUCTURE CODE IS NOT ZERO FOR MATRIX ,I4) SOLN 360
17 FORMAT(1H1,17HORIGINAL B VECTOR,////) SOLN 370
18 FORMAT(1H1,15HSOLUTION VALUES,////) SOLN 380
19 FORMAT(1H0,18HMATRIX IS SINGULAR) SOLN 390
20 FORMAT(7F10.0) SOLN 400
21 FORMAT(I3,10X,E16.6) SOLN 410
22 FORMAT(1H0,11HEND OF CASE) SOLN 420
C SOLN 430
C ..................................................................SOLN 440
C SOLN 450
WRITE (6,10) SOLN 460
25 CALL MATIN(ICOD,A,2500,N,M,MS,IER) SOLN 470
IF(N) 30,95,30 SOLN 480
30 IF(IER-1) 45,35,40 SOLN 490
35 WRITE(6,11) ICOD SOLN 500
GO TO 90 SOLN 510
40 WRITE(6,14) ICOD SOLN 520
GO TO 95 SOLN 530
45 IF(N-M) 50,55,50 SOLN 540
50 WRITE(6,13) ICOD SOLN 550
GO TO 90 SOLN 560
55 IF(MS) 60,65,60 SOLN 570
60 WRITE(6,16) ICOD SOLN 580
GO TO 90 SOLN 590
65 CALL MXOUT(ICOD,A,N,M,MS,60,120,2) SOLN 600
READ(5,20)(B(I),I=1,N) SOLN 610
WRITE(6,17) SOLN 620
DO 70 I=1,N SOLN 630
70 WRITE(6,21) I,B(I) SOLN 640
CALL SIMQ(A,B,N,KS) SOLN 650
IF(KS-1) 80,75,80 SOLN 660
75 WRITE(6,19) SOLN 670
WRITE(6,15) SOLN 680
GO TO 25 SOLN 690
80 WRITE(6,18) SOLN 700
DO 85 I=1,N SOLN 710
85 WRITE(6,21) I,B(I) SOLN 720
WRITE(6,22) SOLN 730
GO TO 25 SOLN 740
90 READ(5,20)(B(I),I=1,N) SOLN 750
WRITE(6,15) SOLN 760
GO TO 25 SOLN 770
95 WRITE(6,12) SOLN 780
RETURN SOLN 790
END SOLN 800
$FORTRAN MATIN
C MATI 10
C ..................................................................MATI 20
C MATI 30
C SUBROUTINE MATIN MATI 40
C MATI 50
C PURPOSE MATI 60
C READS CONTROL CARD AND MATRIX DATA ELEMENTS FROM LOGICAL MATI 70
C UNIT 5 MATI 80
C MATI 90
C USAGE MATI 100
C CALL MATIN(ICODE,A,ISIZE,IROW,ICOL,IS,IER) MATI 110
C MATI 120
C DESCRIPTION OF PARAMETERS MATI 130
C ICODE-UPON RETURN, ICODE WILL CONTAIN FOUR DIGIT MATI 140
C IDENTIFICATION CODE FROM MATRIX PARAMETER CARD MATI 150
C A -DATA AREA FOR INPUT MATRIX MATI 160
C ISIZE-NUMBER OF ELEMENTS DIMENSIONED BY USER FOR AREA A MATI 170
C IROW -UPON RETURN, IROW WILL CONTAIN ROW DIMENSION FROM MATI 180
C MATRIX PARAMETER CARD MATI 190
C ICOL -UPON RETURN, ICOL WILL CONTAIN COLUMN DIMENSION FROM MATI 200
C MATRIX PARAMETER CARD MATI 210
C IS -UPON RETURN, IS WILL CONTAIN STORAGE MODE CODE FROM MATI 220
C MATRIX PARAMETER CARD WHERE MATI 230
C IS=0 GENERAL MATRIX MATI 240
C IS=1 SYMMETRIC MATRIX MATI 250
C IS=2 DIAGONAL MATRIX MATI 260
C IER -UPON RETURN, IER WILL CONTAIN AN ERROR CODE WHERE MATI 270
C IER=0 NO ERROR MATI 280
C IER=1 ISIZE IS LESS THAN NUMBER OF ELEMENTS IN MATI 290
C INPUT MATRIX MATI 300
C IER=2 INCORRECT NUMBER OF DATA CARDS MATI 310
C MATI 320
C REMARKS MATI 330
C NONE MATI 340
C MATI 350
C SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED MATI 360
C LOC MATI 370
C MATI 380
C METHOD MATI 390
C SUBROUTINE ASSUMES THAT INPUT MATRIX CONSISTS OF PARAMETER MATI 400
C CARD FOLLOWED BY DATA CARDS MATI 410
C PARAMETER CARD HAS THE FOLLOWING FORMAT MATI 420
C COL. 1- 2 BLANK MATI 430
C COL. 3- 6 UP TO FOUR DIGIT IDENTIFICATION CODE MATI 440
C COL. 7-10 NUMBER OF ROWS IN MATRIX MATI 450
C COL.11-14 NUMBER OF COLUMNS IN MATRIX MATI 460
C COL.15-16 STORAGE MODE OF MATRIX WHERE MATI 470
C 0 - GENERAL MATRIX MATI 480
C 1 - SYMMETRIC MATRIX MATI 490
C 2 - DIAGONAL MATRIX MATI 500
C DATA CARDS ARE ASSUMED TO HAVE SEVEN FIELDS OF TEN COLUMNS MATI 510
C EACH. DECIMAL POINT MAY APPEAR ANYWHERE IN A FIELD. IF NO MATI 520
C DECIMAL POINT IS INCLUDED, IT IS ASSUMED THAT THE DECIMAL MATI 530
C POINT IS AT THE END OF THE 10 COLUMN FIELD. NUMBER IN EACH MATI 540
C FIELD MAY BE PRECEDED BY BLANKS. DATA ELEMENTS MUST BE MATI 550
C PUNCHED BY ROW. A ROW MAY CONTINUE FROM CARD TO CARD. MATI 560
C HOWEVER EACH NEW ROW MUST START IN THE FIRST FIELD OF THE MATI 570
C NEXT CARD. ONLY THE UPPER TRIANGULAR PORTION OF A SYMMETRICMATI 580
C OR THE DIAGONAL ELEMENTS OF A DIAGONAL MATRIX ARE CONTAINED MATI 590
C ON DATA CARDS. THE FIRST ELEMENT OF EACH NEW ROW WILL BE MATI 600
C THE DIAGONAL ELEMENT FOR A MATRIX WITH SYMMETRIC OR MATI 610
C DIAGONAL STORAGE MODE. COLUMNS 71-80 OF DATA CARDS MAY BE MATI 620
C USED FOR IDENTIFICATION, SEQUENCE NUMBERING, ETC.. MATI 630
C THE LAST DATA CARD FOR ANY MATRIX MUST BE FOLLOWED BY A CARDMATI 640
C WITH A 9 PUNCH IN COLUMN 1. MATI 650
C MATI 660
C.......................................................................MATI 670
C MATI 680
SUBROUTINE MATIN(ICODE, A,ISIZE,IROW,ICOL,IS,IER) MATI 690
DIMENSION A(1) MATI 700
DIMENSION CARD(8) MATI 710
1 FORMAT(7F10.0) MATI 720
2 FORMAT(I6,2I4,I2) MATI 730
C MATI 740
IDC=7 MATI 750
IER=0 MATI 760
READ( 5,2,END=999)ICODE,IROW,ICOL,IS MATI 770
CALL LOC(IROW,ICOL,ICNT,IROW,ICOL,IS) MATI 780
IF(ISIZE-ICNT)6,7,7 MATI 790
6 IER=1 MATI 800
7 IF (ICNT)38,38,8 MATI 810
8 ICOLT=ICOL MATI 820
IROCR=1 MATI 830
C MATI 840
C COMPUTE NUMBER OF CARDS FOR THIS ROW MATI 850
C MATI 860
11 IRCDS=(ICOLT-1)/IDC+1 MATI 870
IF(IS-1)15,15,12 MATI 880
12 IRCDS=1 MATI 890
C MATI 900
C SET UP LOOP FOR NUMBER OF CARDS IN ROW MATI 910
C MATI 920
15 DO 31 K=1,IRCDS MATI 930
READ(5,1)(CARD(I),I=1,IDC) MATI 940
C MATI 950
C SKIP THROUGH DATA CARDS IF INPUT AREA TOO SMALL MATI 960
C MATI 970
IF(IER)16,16,31 MATI 980
16 L=0 MATI 990
C MATI1000
C COMPUTE COLUMN NUMBER FOR FIRST FIELD IN CURRENT CARD MATI1010
C MATI1020
JS=(K-1)*IDC+ICOL-ICOLT+1 MATI1030
JE=JS+IDC-1 MATI1040
IF(IS-1)19,19,17 MATI1050
17 JE=JS MATI1060
C MATI1070
C SET UP LOOP FOR DATA ELEMENTS WITHIN CARD MATI1080
C MATI1090
19 DO 30 J=JS,JE MATI1100
IF(J-ICOL)20,20,31 MATI1110
20 CALL LOC(IROCR ,J,IJ,IROW,ICOL,IS) MATI1120
L=L+1 MATI1130
30 A(IJ)=CARD(L) MATI1140
31 CONTINUE MATI1150
IROCR=IROCR+1 MATI1160
IF(IROW-IROCR) 38,35,35 MATI1170
35 IF(IS-1)37,36,36 MATI1180
36 ICOLT=ICOLT-1 MATI1190
37 GO TO 11 MATI1200
38 READ(5,1,END=999) CARD(1) MATI1210
IF(CARD(1)-9.E9)39,40,39 MATI1220
39 IER=2 MATI1230
40 RETURN MATI1240
999 STOP
END MATI1250
$FORTRAN MXOUT
C MXOU 10
C ..................................................................MXOU 20
C MXOU 30
C SUBROUTINE MXOUT MXOU 40
C MXOU 50
C PURPOSE MXOU 60
C PRODUCES AN OUTPUT LISTING OF ANY SIZED ARRAY ON MXOU 70
C LOGICAL UNIT 6 MXOU 80
C MXOU 90
C USAGE MXOU 100
C CALL MXOUT(ICODE,A,N,M,MS,LINS,IPOS,ISP) MXOU 110
C MXOU 120
C DESCRIPTION OF PARAMETERS MXOU 130
C ICODE- INPUT CODE NUMBER TO BE PRINTED ON EACH OUTPUT PAGE MXOU 140
C A-NAME OF OUTPUT MATRIX MXOU 150
C N-NUMBER OF ROWS IN A MXOU 160
C M-NUMBER OF COLUMNS IN A MXOU 170
C MS-STORAGE MODE OF A WHERE MS= MXOU 180
C 0-GENERAL MXOU 190
C 1-SYMMETRIC MXOU 200
C 2-DIAGONAL MXOU 210
C LINS-NUMBER OF PRINT LINES ON THE PAGE (USUALLY 60) MXOU 220
C IPOS-NUMBER OF PRINT POSITIONS ACROSS THE PAGE (USUALLY 132)MXOU 230
C ISP-LINE SPACING CODE, 1 FOR SINGLE SPACE, 2 FOR DOUBLE MXOU 240
C SPACE MXOU 250
C MXOU 260
C REMARKS MXOU 270
C NONE MXOU 280
C MXOU 290
C SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED MXOU 300
C LOC MXOU 310
C MXOU 320
C METHOD MXOU 330
C THIS SUBROUTINE CREATES A STANDARD OUTPUT LISTING OF ANY MXOU 340
C SIZED ARRAY WITH ANY STORAGE MODE. EACH PAGE IS HEADED WITH MXOU 350
C THE CODE NUMBER,DIMENSIONS AND STORAGE MODE OF THE ARRAY. MXOU 360
C EACH COLUMN AND ROW IS ALSO HEADED WITH ITS RESPECTIVE MXOU 370
C NUMBER. MXOU 380
C MXOU 390
C ..................................................................MXOU 400
C MXOU 410
SUBROUTINE MXOUT (ICODE,A,N,M,MS,LINS,IPOS,ISP) MXOU 420
DIMENSION A(1),B(8) MXOU 430
1 FORMAT(1H1,5X, 7HMATRIX ,I5,6X,I3,5H ROWS,6X,I3,8H COLUMNS, MXOU 440
18X,13HSTORAGE MODE ,I1,8X,5HPAGE ,I2,/) MXOU 450
2 FORMAT(12X,8HCOLUMN ,7(3X,I3,10X)) MXOU 460
3 FORMAT(1H ) MXOU 470
4 FORMAT(1H ,7X,4HROW ,I3,7(E16.6)) MXOU 480
5 FORMAT(1H0,7X,4HROW ,I3,7(E16.6)) MXOU 490
C MXOU 500
J=1 MXOU 510
C MXOU 520
C WRITE HEADING MXOU 530
C MXOU 540
NEND=IPOS/16-1 MXOU 550
LEND=(LINS/ISP)-2 MXOU 560
IPAGE=1 MXOU 570
10 LSTRT=1 MXOU 580
20 WRITE(6,1)ICODE,N,M,MS,IPAGE MXOU 590
JNT=J+NEND-1 MXOU 600
IPAGE=IPAGE+1 MXOU 610
31 IF(JNT-M)33,33,32 MXOU 620
32 JNT=M MXOU 630
33 CONTINUE MXOU 640
WRITE(6,2)(JCUR,JCUR=J,JNT) MXOU 650
IF(ISP-1) 35,35,40 MXOU 660
35 WRITE(6,3) MXOU 670
40 LTEND=LSTRT+LEND-1 MXOU 680
DO 80 L=LSTRT,LTEND MXOU 690
C MXOU 700
C FORM OUTPUT ROW LINE MXOU 710
C MXOU 720
DO 55 K=1,NEND MXOU 730
KK=K MXOU 740
JT = J+K-1 MXOU 750
CALL LOC(L,JT,IJNT,N,M,MS) MXOU 760
B(K)=0.0 MXOU 770
IF(IJNT)50,50,45 MXOU 780
45 B(K)=A(IJNT) MXOU 790
50 CONTINUE MXOU 800
C MXOU 810
C CHECK IF LAST COLUMN. IF YES GO TO 60 MXOU 820
C MXOU 830
IF(JT-M) 55,60,60 MXOU 840
55 CONTINUE MXOU 850
C MXOU 860
C END OF LINE, NOW WRITE MXOU 870
C MXOU 880
60 IF(ISP-1)65,65,70 MXOU 890
65 WRITE(6,4)L,(B(JW),JW=1,KK) MXOU 900
GO TO 75 MXOU 910
70 WRITE(6,5)L,(B(JW),JW=1,KK) MXOU 920
C MXOU 930
C IF END OF ROWS,GO CHECK COLUMNS MXOU 940
C MXOU 950
75 IF(N-L)85,85,80 MXOU 960
80 CONTINUE MXOU 970
C MXOU 980
C END OF PAGE, NOW CHECK FOR MORE OUTPUT MXOU 990
C MXOU1000
LSTRT=LSTRT+LEND MXOU1010
GO TO 20 MXOU1020
C MXOU1030
C END OF COLUMNS, THEN RETURN MXOU1040
C MXOU1050
85 IF(JT-M)90,95,95 MXOU1060
90 J=JT+1 MXOU1070
GO TO 10 MXOU1080
95 RETURN MXOU1090
END MXOU1100
$DECK SOL.CDR
000100100010 20
1.0000000 0.6644085 0.7601008 0.7507505 0.4299425 0.0033291 0.7284786 30
0.6751766 0.8635910 0.7446845 40
0.6644085 1.0000000 0.6271802 0.6194650 0.3547574 0.0027470 0.6010878 50
0.5571068 0.7125728 0.6144597 60
0.7601008 0.6271802 1.0000000 0.7086843 0.4058519 0.0031426 0.6876602 70
0.6373449 0.8152021 0.7029582 80
0.7507505 0.6194650 0.7086843 1.0000000 0.4008593 0.0031039 0.6792011 90
0.6295047 0.8051740 0.6943108 100
0.4299425 0.3547574 0.4058519 0.4008593 1.0000000 0.0017776 0.3889673 110
0.3605070 0.4611099 0.3976204 120
0.0033291 0.0027470 0.0031426 0.0031039 0.0017776 1.0000000 0.0030119 130
0.0027915 0.0035705 0.0030789 140
0.7284786 0.6010878 0.6876602 0.6792011 0.3889673 0.0030119 1.0000000 150
0.6108296 0.7812874 0.6737132 160
0.6751766 0.5571068 0.6373449 0.6295047 0.3605070 0.0027915 0.6108296 170
1.0000000 0.7241215 0.6244183 180
0.8635910 0.7125728 0.8152021 0.8051740 0.4611099 0.0035705 0.7812874 190
0.7241215 1.0000000 0.7986682 200
0.7446845 0.6144597 0.7029582 0.6943108 0.3976204 0.0030789 0.6737132 210
0.6244183 0.7986682 1.0000000 220
9 230
110. -120. 10. 145. -50. 44.2 -14. 240
38.5 22. 1650. 250
$EOD
.ASSIGN CDR 5
.ASSIGN LPT 6
.SET CDR SOL
.EXECUTE/REL SOLN,MATIN,MXOUT,WES:SSP/LIB
%FIN::
.DELETE SOL.CDR