$JOB ADSAM[30,30]
$FORTRAN ADSAM
C ADSA 10
C ..................................................................ADSA 20
C ADSA 30
C SAMPLE MAIN PROGRAM FOR MATRIX ADDITION - ADSAM ADSA 40
C ADSA 50
C PURPOSE ADSA 60
C MATRIX ADDITION SAMPLE PROGRAM ADSA 70
C ADSA 80
C SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED ADSA 90
C MADD ADSA 100
C MATIN ADSA 110
C MXOUT ADSA 120
C LOC ADSA 130
C ADSA 140
C METHOD ADSA 150
C TWO INPUT MATRICES ARE READ FROM THE STANDARD INPUT DEVICE. ADSA 160
C THEY ARE ADDED AND THE RESULTANT MATRIX IS LISTED ON ADSA 170
C THE STANDARD OUTPUT DEVICE. THIS CAN BE REPEATED FOR ANY ADSA 180
C NUMBER OF PAIRS OF MATRICES UNTIL A BLANK CARD IS ADSA 190
C ENCOUNTERED ADSA 200
C ADSA 210
C ..................................................................ADSA 220
C ADSA 230
C MATRICES ARE DIMENSIONED FOR 1000 ELEMENTS. THEREFORE, PRODUCT ADSA 240
C OF NUMBER OF ROWS BY NUMBER OF COLUMNS CANNOT EXCEED 1000. ADSA 250
C ADSA 260
DIMENSION A(1000),B(1000),R(1000) ADSA 270
C ADSA 280
10 FORMAT(1H1,15HMATRIX ADDITION) ADSA 290
11 FORMAT(1H0,44HDIMENSIONED AREA TOO SMALL FOR INPUT MATRIX ,I4) ADSA 300
12 FORMAT(1H0,20HEXECUTION TERMINATED) ADSA 310
13 FORMAT(1H0,32HMATRIX DIMENSIONS NOT CONSISTENT) ADSA 320
14 FORMAT(1H0,42HINCORRECT NUMBER OF DATA CARDS FOR MATRIX ,I4) ADSA 330
15 FORMAT(1H0,18HGO ON TO NEXT CASE) ADSA 340
16 FORMAT(1H0,11HEND OF CASE) ADSA 350
C ADSA 360
C ..................................................................ADSA 370
C ADSA 380
WRITE(6,10) ADSA 390
20 CALL MATIN(ICODA,A,1000,NA,MA,MSA,IER) ADSA 400
IF( NA ) 25,95,25 ADSA 410
25 IF(IER-1) 40,30,35 ADSA 420
30 WRITE(6,11) ICODA ADSA 430
GO TO 45 ADSA 440
35 WRITE(6,14) ICODA ADSA 450
37 WRITE(6,12) ADSA 460
GO TO 95 ADSA 470
40 CALL MXOUT(ICODA,A,NA,MA,MSA,60,120,2) ADSA 480
45 CALL MATIN(ICODB,B,1000,NB,MB,MSB,IER) ADSA 490
IF(IER-1) 60,50,55 ADSA 500
50 WRITE(6,11) ICODB ADSA 510
WRITE(6,15) ADSA 520
GO TO 20 ADSA 530
55 WRITE(6,14) ICODB ADSA 540
GO TO 37 ADSA 550
60 IF(NA-NB) 75,70,75 ADSA 560
70 IF(MA-MB) 75,80,75 ADSA 570
75 WRITE(6,13) ADSA 580
WRITE(6,15) ADSA 590
GO TO 20 ADSA 600
80 CALL MXOUT(ICODB,B,NB,MB,MSB,60,120,2) ADSA 610
ICODR=ICODA+ICODB ADSA 620
CALL MADD(A,B,R,NA,MA,MSA,MSB) ADSA 630
MSR=MSA ADSA 640
IF(MSA-MSB) 90,90,85 ADSA 650
85 MSR=MSB ADSA 660
90 CALL MXOUT(ICODR,R,NA,MA,MSR,60,120,2) ADSA 670
WRITE(6,16) ADSA 680
GO TO 20 ADSA 690
95 RETURN ADSA 700
END ADSA 710
$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 ADS.CDR
00010008001100 20
0.7601008 0.6271802 1.0000000 0.7086843 0.4058519 0.0031426 0.6876602 30
0.6751766 0.8635910 0.7446845 0.6963269 40
0.6644085 1.0000000 0.6271802 0.6194650 0.3547574 0.0027470 0.6010878 50
0.5571068 0.7125728 0.6144597 0.5745585 60
1.0000000 0.6644085 0.7601008 0.7507505 0.4299425 0.0033291 0.7284786 70
0.6373449 0.8152021 0.7029582 0.6573101 80
0.6963269 0.5745585 0.6573101 0.6492243 0.3718001 0.0028789 0.6299642 90
0.6295047 0.8051740 0.6943108 0.6492243 100
0.7446845 0.6144597 0.7029582 0.6943108 0.3976204 0.0030789 0.6737132 110
0.3605070 0.4611099 0.3976204 0.3718001 120
0.6751766 0.5571068 0.6373449 0.6295047 0.3605070 0.0027915 0.6108296 130
0.0027915 0.0035705 0.0030789 0.0028789 140
0.0033291 0.0027470 0.0031426 0.0031039 0.0017776 1.0000000 0.0030119 150
0.6108296 0.7812874 0.6737132 0.6299642 160
0.4299425 0.3547574 0.4058519 0.4008593 1.0000000 0.0017776 0.3889673 170
1.0000000 0.7241215 0.6244183 0.5838704 180
9 190
00020008001100 200
0.7507505 0.6194650 0.7086843 1.0000000 0.4008593 0.0031039 0.6792011 210
0.7241215 1.0000000 0.7986682 0.7468050 220
0.7446845 0.6144597 0.7029582 0.6943108 0.3976204 0.0030789 0.6737132 230
0.6244183 0.7986682 1.0000000 0.6439786 240
0.8635910 0.7125728 0.8152021 0.8051740 0.4611099 0.0035705 0.7812874 250
0.5838704 0.7468050 0.6439786 1.0000000 260
0.6963269 0.5745585 0.6573101 0.6492243 0.3718001 0.0028789 0.6299642 270
1.0000000 0.6644085 0.7601008 0.7507505 0.4299425 0.0033291 0.7284786 280
0.6751766 0.5571068 0.6373449 0.6295047 0.3605070 0.0027915 0.6108296 290
0.7284786 0.6010878 0.6876602 0.6792011 0.3889673 0.0030119 1.0000000 300
0.7446845 0.6144597 0.7029582 0.6943108 0.3976204 0.0030789 0.6737132 310
0.4299425 0.3547574 0.4058519 0.4008593 1.0000000 0.0017776 0.3889673 320
0.8635910 0.7125728 0.8152021 0.8051740 0.4611099 0.0035705 0.7812874 330
0.7601008 0.6271802 1.0000000 0.7086843 0.4058519 0.0031426 0.6876602 340
0.7601008 0.6271802 1.0000000 0.7086843 0.4058519 0.0031426 0.6876602 350
0.6963269 0.5745585 0.6573101 0.6492243 0.3718001 0.0028789 0.6299642 360
9 370
380
$EOD
.ASSIGN CDR 5
.ASSIGN LPT 6
.SET CDR ADS
.EXECUTE/REL ADSAM,MATIN,MXOUT,WES:SSP/LIB
%FIN::
.DELETE ADS.CDR