Trailing-Edge
-
PDP-10 Archives
-
decuslib20-02
-
decus/20-0026/mlss.ssp
There are 2 other files named mlss.ssp in the archive. Click here to see a list.
C MLSS 10
C ..................................................................MLSS 20
C MLSS 30
C SUBROUTINE MLSS MLSS 40
C MLSS 50
C PURPOSE MLSS 60
C SUBROUTINE MLSS IS THE SECOND STEP IN THE PROCEDURE FOR MLSS 70
C CALCULATING THE LEAST SQUARES SOLUTION OF MINIMAL LENGTH MLSS 80
C OF A SYSTEM OF SIMULTANEOUS LINEAR EQUATIONS WITH SYMMETRIC MLSS 90
C POSITIVE SEMI-DEFINITE COEFFICIENT MATRIX. MLSS 100
C MLSS 110
C USAGE MLSS 120
C CALL MLSS(A,N,IRANK,TRAC,INC,RHS,IER) MLSS 130
C MLSS 140
C DESCRIPTION OF PARAMETERS MLSS 150
C A - COEFFICIENT MATRIX IN FACTORED FORM AS GENERATED MLSS 160
C BY SUBROUTINE MFSS FROM INITIALLY GIVEN SYMMETRIC MLSS 170
C COEFFICIENT MATRIX A STORED IN N*(N+1)/2 LOCATIONS MLSS 180
C A REMAINS UNCHANGED MLSS 190
C N - DIMENSION OF COEFFICIENT MATRIX MLSS 200
C IRANK - RANK OF COEFFICIENT MATRIX, CALCULATED BY MEANS OF MLSS 210
C SUBROUTINE MFSS MLSS 220
C TRAC - VECTOR OF DIMENSION N CONTAINING THE MLSS 230
C SUBSCRIPTS OF PIVOT ROWS AND COLUMNS, I.E. THE MLSS 240
C PRODUCT REPRESENTATION IN TRANSPOSITIONS OF THE MLSS 250
C PERMUTATION WHICH WAS APPLIED TO ROWS AND COLUMNS MLSS 260
C OF A IN THE FACTORIZATION PROCESS MLSS 270
C TRAC IS A RESULTANT ARRAY OF SUBROUTINE MFSS MLSS 280
C INC - INPUT VARIABLE WHICH SHOULD CONTAIN THE VALUE ZERO MLSS 290
C IF THE SYSTEM OF SIMULTANEOUS EQUATIONS IS KNOWN MLSS 300
C TO BE COMPATIBLE AND A NONZERO VALUE OTHERWISE MLSS 310
C RHS - VECTOR OF DIMENSION N CONTAINING THE RIGHT HAND SIDEMLSS 320
C ON RETURN RHS CONTAINS THE MINIMAL LENGTH SOLUTION MLSS 330
C IER - RESULTANT ERROR PARAMETER MLSS 340
C IER = 0 MEANS NO ERRORS MLSS 350
C IER =-1 MEANS N AND/OR IRANK IS NOT POSITIVE AND/OR MLSS 360
C IRANK IS GREATER THAN N MLSS 370
C IER = 1 MEANS THE FACTORIZATION CONTAINED IN A HAS MLSS 380
C ZERO DIVISORS AND/OR TRAC CONTAINS MLSS 390
C VALUES OUTSIDE THE FEASIBLE RANGE 1 UP TO N MLSS 400
C MLSS 410
C REMARKS MLSS 420
C THE MINIMAL LENGTH SOLUTION IS PRODUCED IN THE STORAGE MLSS 430
C LOCATIONS OCCUPIED BY THE RIGHT HAND SIDE. MLSS 440
C SUBROUTINE MLSS DOES TAKE CARE OF THE PERMUTATION MLSS 450
C WHICH WAS APPLIED TO ROWS AND COLUMNS OF A. MLSS 460
C OPERATION IS BYPASSED IN CASE OF A NON POSITIVE VALUE MLSS 470
C OF IRANK MLSS 480
C MLSS 490
C SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED MLSS 500
C NONE MLSS 510
C MLSS 520
C METHOD MLSS 530
C LET T, U, TU BE THE COMPONENTS OF THE FACTORIZATION OF A, MLSS 540
C AND LET THE RIGHT HAND SIDE BE PARTITIONED INTO A FIRST MLSS 550
C PART X1 OF DIMENSION IRANK AND A SECOND PART X2 OF DIMENSIONMLSS 560
C N-IRANK. THEN THE FOLLOWING OPERATIONS ARE APPLIED IN MLSS 570
C SEQUENCE MLSS 580
C (1) INTERCHANGE RIGHT HAND SIDE MLSS 590
C (2) X1 = X1 + U * X2 MLSS 600
C (3) X2 =-TRANSPOSE(U) * X1 MLSS 610
C (4) X2 = INVERSE(TU) * INVERSE(TRANSPOSE(TU)) * X2 MLSS 620
C (5) X1 = X1 + U * X2 MLSS 630
C (6) X1 = INVERSE(T) * INVERSE(TRANSPOSE(T)) * X1 MLSS 640
C (7) X2 =-TRANSPOSE(U) * X1 MLSS 650
C (8) X2 = INVERSE(TU) * INVERSE(TRANSPOSE(TU)) * X2 MLSS 660
C (9) X1 = X1 + U * X2 MLSS 670
C (10)X2 = TRANSPOSE(U) * X1 MLSS 680
C (11) REINTERCHANGE CALCULATED SOLUTION MLSS 690
C IF THE SYSTEM OF SIMULTANEOUS LINEAR EQUATIONS IS SPECIFIED MLSS 700
C TO BE COMPATIBLE THEN STEPS (2), (3), (4) AND (5) ARE MLSS 710
C CANCELLED. MLSS 720
C IF THE COEFFICIENT MATRIX HAS RANK N, THEN THE ONLY STEPS MLSS 730
C PERFORMED ARE (1), (6) AND (11). MLSS 740
C MLSS 750
C ..................................................................MLSS 760
C MLSS 770
SUBROUTINE MLSS(A,N,IRANK,TRAC,INC,RHS,IER) MLSS 780
C MLSS 790
C MLSS 800
C DIMENSIONED DUMMY VARIABLES MLSS 810
DIMENSION A(1),TRAC(1),RHS(1) MLSS 820
DOUBLE PRECISION SUM MLSS 830
C MLSS 840
C TEST OF SPECIFIED DIMENSIONS MLSS 850
IDEF=N-IRANK MLSS 860
IF(N)33,33,1 MLSS 870
1 IF(IRANK)33,33,2 MLSS 880
2 IF(IDEF)33,3,3 MLSS 890
C MLSS 900
C CALCULATE AUXILIARY VALUES MLSS 910
3 ITE=IRANK*(IRANK+1)/2 MLSS 920
IX2=IRANK+1 MLSS 930
NP1=N+1 MLSS 940
IER=0 MLSS 950
C MLSS 960
C INTERCHANGE RIGHT HAND SIDE MLSS 970
JJ=1 MLSS 980
II=1 MLSS 990
4 DO 6 I=1,N MLSS1000
J=TRAC(II) MLSS1010
IF(J)31,31,5 MLSS1020
5 HOLD=RHS(II) MLSS1030
RHS(II)=RHS(J) MLSS1040
RHS(J)=HOLD MLSS1050
6 II=II+JJ MLSS1060
IF(JJ)32,7,7 MLSS1070
C MLSS1080
C PERFORM STEP 2 IF NECESSARY MLSS1090
7 ISW=1 MLSS1100
IF(INC*IDEF)8,28,8 MLSS1110
C MLSS1120
C CALCULATE X1 = X1 + U * X2 MLSS1130
8 ISTA=ITE MLSS1140
DO 10 I=1,IRANK MLSS1150
ISTA=ISTA+1 MLSS1160
JJ=ISTA MLSS1170
SUM=0.D0 MLSS1180
DO 9 J=IX2,N MLSS1190
SUM=SUM+A(JJ)*RHS(J) MLSS1200
9 JJ=JJ+J MLSS1210
10 RHS(I)=RHS(I)+SUM MLSS1220
GOTO(11,28,11),ISW MLSS1230
C MLSS1240
C CALCULATE X2 = TRANSPOSE(U) * X1 MLSS1250
11 ISTA=ITE MLSS1260
DO 15 I=IX2,N MLSS1270
JJ=ISTA MLSS1280
SUM=0.D0 MLSS1290
DO 12 J=1,IRANK MLSS1300
JJ=JJ+1 MLSS1310
12 SUM=SUM+A(JJ)*RHS(J) MLSS1320
GOTO(13,13,14),ISW MLSS1330
13 SUM=-SUM MLSS1340
14 RHS(I)=SUM MLSS1350
15 ISTA=ISTA+I MLSS1360
GOTO(16,29,30),ISW MLSS1370
C MLSS1380
C INITIALIZE STEP (4) OR STEP (8) MLSS1390
16 ISTA=IX2 MLSS1400
IEND=N MLSS1410
JJ=ITE+ISTA MLSS1420
C MLSS1430
C DIVISION OF X1 BY TRANSPOSE OF TRIANGULAR MATRIX MLSS1440
17 SUM=0.D0 MLSS1450
DO 20 I=ISTA,IEND MLSS1460
IF(A(JJ))18,31,18 MLSS1470
18 RHS(I)=(RHS(I)-SUM)/A(JJ) MLSS1480
IF(I-IEND)19,21,21 MLSS1490
19 JJ=JJ+ISTA MLSS1500
SUM=0.D0 MLSS1510
DO 20 J=ISTA,I MLSS1520
SUM=SUM+A(JJ)*RHS(J) MLSS1530
20 JJ=JJ+1 MLSS1540
C MLSS1550
C DIVISION OF X1 BY TRIANGULAR MATRIX MLSS1560
21 SUM=0.D0 MLSS1570
II=IEND MLSS1580
DO 24 I=ISTA,IEND MLSS1590
RHS(II)=(RHS(II)-SUM)/A(JJ) MLSS1600
IF(II-ISTA)25,25,22 MLSS1610
22 KK=JJ-1 MLSS1620
SUM=0.D0 MLSS1630
DO 23 J=II,IEND MLSS1640
SUM=SUM+A(KK)*RHS(J) MLSS1650
23 KK=KK+J MLSS1660
JJ=JJ-II MLSS1670
24 II=II-1 MLSS1680
25 IF(IDEF)26,30,26 MLSS1690
26 GOTO(27,11,8),ISW MLSS1700
C MLSS1710
C PERFORM STEP (5) MLSS1720
27 ISW=2 MLSS1730
GOTO 8 MLSS1740
C MLSS1750
C PERFORM STEP (6) MLSS1760
28 ISTA=1 MLSS1770
IEND=IRANK MLSS1780
JJ=1 MLSS1790
ISW=2 MLSS1800
GOTO 17 MLSS1810
C MLSS1820
C PERFORM STEP (8) MLSS1830
29 ISW=3 MLSS1840
GOTO 16 MLSS1850
C MLSS1860
C REINTERCHANGE CALCULATED SOLUTION MLSS1870
30 II=N MLSS1880
JJ=-1 MLSS1890
GOTO 4 MLSS1900
C MLSS1910
C ERROR RETURN IN CASE OF ZERO DIVISOR MLSS1920
31 IER=1 MLSS1930
32 RETURN MLSS1940
C MLSS1950
C ERROR RETURN IN CASE OF ILLEGAL DIMENSION MLSS1960
33 IER=-1 MLSS1970
RETURN MLSS1980
END MLSS1990