Trailing-Edge
-
PDP-10 Archives
-
decuslib20-02
-
decus/20-0026/dmlss.ssp
There are 2 other files named dmlss.ssp in the archive. Click here to see a list.
C DMLS 10
C ..................................................................DMLS 20
C DMLS 30
C SUBROUTINE DMLSS DMLS 40
C DMLS 50
C PURPOSE DMLS 60
C SUBROUTINE DMLSS IS THE SECOND STEP IN THE PROCEDURE FOR DMLS 70
C CALCULATING THE LEAST SQUARES SOLUTION OF MINIMAL LENGTH DMLS 80
C OF A SYSTEM OF SIMULTANEOUS LINEAR EQUATIONS WITH SYMMETRIC DMLS 90
C POSITIVE SEMI-DEFINITE COEFFICIENT MATRIX. DMLS 100
C DMLS 110
C USAGE DMLS 120
C CALL DMLSS(A,N,IRANK,TRAC,INC,RHS,IER) DMLS 130
C DMLS 140
C DESCRIPTION OF PARAMETERS DMLS 150
C A - COEFFICIENT MATRIX IN FACTORED FORM AS GENERATED DMLS 160
C BY SUBROUTINE MFSS FROM INITIALLY GIVEN SYMMETRIC DMLS 170
C COEFFICIENT MATRIX A STORED IN N*(N+1)/2 LOCATIONS DMLS 180
C A REMAINS UNCHANGED DMLS 190
C A MUST BE OF DOUBLE PRECISION DMLS 200
C N - DIMENSION OF COEFFICIENT MATRIX DMLS 210
C IRANK - RANK OF COEFFICIENT MATRIX, CALCULATED BY MEANS OF DMLS 220
C SUBROUTINE DMFSS DMLS 230
C TRAC - VECTOR OF DIMENSION N CONTAINING THE DMLS 240
C SUBSCRIPTS OF PIVOT ROWS AND COLUMNS, I.E. THE DMLS 250
C PRODUCT REPRESENTATION IN TRANSPOSITIONS OF THE DMLS 260
C PERMUTATION WHICH WAS APPLIED TO ROWS AND COLUMNS DMLS 270
C OF A IN THE FACTORIZATION PROCESS DMLS 280
C TRAC IS A RESULTANT ARRAY OF SUBROUTINE MFSS DMLS 290
C TRAC MUST BE OF DOUBLE PRECISION DMLS 300
C INC - INPUT VARIABLE WHICH SHOULD CONTAIN THE VALUE ZERO DMLS 310
C IF THE SYSTEM OF SIMULTANEOUS EQUATIONS IS KNOWN DMLS 320
C TO BE COMPATIBLE AND A NONZERO VALUE OTHERWISE DMLS 330
C RHS - VECTOR OF DIMENSION N CONTAINING THE RIGHT HAND SIDEDMLS 340
C ON RETURN RHS CONTAINS THE MINIMAL LENGTH SOLUTION DMLS 350
C RHS MUST BE OF DOUBLE PRECISION DMLS 360
C IER - RESULTANT ERROR PARAMETER DMLS 370
C IER = 0 MEANS NO ERRORS DMLS 380
C IER =-1 MEANS N AND/OR IRANK IS NOT POSITIVE AND/OR DMLS 390
C IRANK IS GREATER THAN N DMLS 400
C IER = 1 MEANS THE FACTORIZATION CONTAINED IN A HAS DMLS 410
C ZERO DIVISORS AND/OR TRAC CONTAINS DMLS 420
C VALUES OUTSIDE THE FEASIBLE RANGE 1 UP TO N DMLS 430
C DMLS 440
C REMARKS DMLS 450
C THE MINIMAL LENGTH SOLUTION IS PRODUCED IN THE STORAGE DMLS 460
C LOCATIONS OCCUPIED BY THE RIGHT HAND SIDE. DMLS 470
C SUBROUTINE DMLSS DOES TAKE CARE OF THE PERMUTATION DMLS 480
C WHICH WAS APPLIED TO ROWS AND COLUMNS OF A. DMLS 490
C OPERATION IS BYPASSED IN CASE OF A NON POSITIVE VALUE DMLS 500
C OF IRANK DMLS 510
C DMLS 520
C SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED DMLS 530
C NONE DMLS 540
C DMLS 550
C METHOD DMLS 560
C LET T, U, TU BE THE COMPONENTS OF THE FACTORIZATION OF A, DMLS 570
C AND LET THE RIGHT HAND SIDE BE PARTITIONED INTO A FIRST DMLS 580
C PART X1 OF DIMENSION IRANK AND A SECOND PART X2 OF DIMENSIONDMLS 590
C N-IRANK. THEN THE FOLLOWING OPERATIONS ARE APPLIED IN DMLS 600
C SEQUENCE DMLS 610
C (1) INTERCHANGE RIGHT HAND SIDE DMLS 620
C (2) X1 = X1 + U * X2 DMLS 630
C (3) X2 =-TRANSPOSE(U) * X1 DMLS 640
C (4) X2 = INVERSE(TU) * INVERSE(TRANSPOSE(TU)) * X2 DMLS 650
C (5) X1 = X1 + U * X2 DMLS 660
C (6) X1 = INVERSE(T) * INVERSE(TRANSPOSE(T)) * X1 DMLS 670
C (7) X2 =-TRANSPOSE(U) * X1 DMLS 680
C (8) X2 = INVERSE(TU) * INVERSE(TRANSPOSE(TU)) * X2 DMLS 690
C (9) X1 = X1 + U * X2 DMLS 700
C (10)X2 = TRANSPOSE(U) * X1 DMLS 710
C (11) REINTERCHANGE CALCULATED SOLUTION DMLS 720
C IF THE SYSTEM OF SIMULTANEOUS LINEAR EQUATIONS IS SPECIFIED DMLS 730
C TO BE COMPATIBLE THEN STEPS (2), (3), (4) AND (5) ARE DMLS 740
C CANCELLED. DMLS 750
C IF THE COEFFICIENT MATRIX HAS RANK N, THEN THE ONLY STEPS DMLS 760
C PERFORMED ARE (1), (6) AND (11). DMLS 770
C DMLS 780
C ..................................................................DMLS 790
C DMLS 800
SUBROUTINE DMLSS(A,N,IRANK,TRAC,INC,RHS,IER) DMLS 810
C DMLS 820
C DMLS 830
C DIMENSIONED DUMMY VARIABLES DMLS 840
DIMENSION A(1),TRAC(1),RHS(1) DMLS 850
DOUBLE PRECISION SUM,A,RHS,TRAC,HOLD DMLS 860
C DMLS 870
C TEST OF SPECIFIED DIMENSIONS DMLS 880
IDEF=N-IRANK DMLS 890
IF(N)33,33,1 DMLS 900
1 IF(IRANK)33,33,2 DMLS 910
2 IF(IDEF)33,3,3 DMLS 920
C DMLS 930
C CALCULATE AUXILIARY VALUES DMLS 940
3 ITE=IRANK*(IRANK+1)/2 DMLS 950
IX2=IRANK+1 DMLS 960
NP1=N+1 DMLS 970
IER=0 DMLS 980
C DMLS 990
C INTERCHANGE RIGHT HAND SIDE DMLS1000
JJ=1 DMLS1010
II=1 DMLS1020
4 DO 6 I=1,N DMLS1030
J=TRAC(II) DMLS1040
IF(J)31,31,5 DMLS1050
5 HOLD=RHS(II) DMLS1060
RHS(II)=RHS(J) DMLS1070
RHS(J)=HOLD DMLS1080
6 II=II+JJ DMLS1090
IF(JJ)32,7,7 DMLS1100
C DMLS1110
C PERFORM STEP 2 IF NECESSARY DMLS1120
7 ISW=1 DMLS1130
IF(INC*IDEF)8,28,8 DMLS1140
C DMLS1150
C CALCULATE X1 = X1 + U * X2 DMLS1160
8 ISTA=ITE DMLS1170
DO 10 I=1,IRANK DMLS1180
ISTA=ISTA+1 DMLS1190
JJ=ISTA DMLS1200
SUM=0.D0 DMLS1210
DO 9 J=IX2,N DMLS1220
SUM=SUM+A(JJ)*RHS(J) DMLS1230
9 JJ=JJ+J DMLS1240
10 RHS(I)=RHS(I)+SUM DMLS1250
GOTO(11,28,11),ISW DMLS1260
C DMLS1270
C CALCULATE X2 = TRANSPOSE(U) * X1 DMLS1280
11 ISTA=ITE DMLS1290
DO 15 I=IX2,N DMLS1300
JJ=ISTA DMLS1310
SUM=0.D0 DMLS1320
DO 12 J=1,IRANK DMLS1330
JJ=JJ+1 DMLS1340
12 SUM=SUM+A(JJ)*RHS(J) DMLS1350
GOTO(13,13,14),ISW DMLS1360
13 SUM=-SUM DMLS1370
14 RHS(I)=SUM DMLS1380
15 ISTA=ISTA+I DMLS1390
GOTO(16,29,30),ISW DMLS1400
C DMLS1410
C INITIALIZE STEP (4) OR STEP (8) DMLS1420
16 ISTA=IX2 DMLS1430
IEND=N DMLS1440
JJ=ITE+ISTA DMLS1450
C DMLS1460
C DIVISION OF X1 BY TRANSPOSE OF TRIANGULAR MATRIX DMLS1470
17 SUM=0.D0 DMLS1480
DO 20 I=ISTA,IEND DMLS1490
IF(A(JJ))18,31,18 DMLS1500
18 RHS(I)=(RHS(I)-SUM)/A(JJ) DMLS1510
IF(I-IEND)19,21,21 DMLS1520
19 JJ=JJ+ISTA DMLS1530
SUM=0.D0 DMLS1540
DO 20 J=ISTA,I DMLS1550
SUM=SUM+A(JJ)*RHS(J) DMLS1560
20 JJ=JJ+1 DMLS1570
C DMLS1580
C DIVISION OF X1 BY TRIANGULAR MATRIX DMLS1590
21 SUM=0.D0 DMLS1600
II=IEND DMLS1610
DO 24 I=ISTA,IEND DMLS1620
RHS(II)=(RHS(II)-SUM)/A(JJ) DMLS1630
IF(II-ISTA)25,25,22 DMLS1640
22 KK=JJ-1 DMLS1650
SUM=0.D0 DMLS1660
DO 23 J=II,IEND DMLS1670
SUM=SUM+A(KK)*RHS(J) DMLS1680
23 KK=KK+J DMLS1690
JJ=JJ-II DMLS1700
24 II=II-1 DMLS1710
25 IF(IDEF)26,30,26 DMLS1720
26 GOTO(27,11,8),ISW DMLS1730
C DMLS1740
C PERFORM STEP (5) DMLS1750
27 ISW=2 DMLS1760
GOTO 8 DMLS1770
C DMLS1780
C PERFORM STEP (6) DMLS1790
28 ISTA=1 DMLS1800
IEND=IRANK DMLS1810
JJ=1 DMLS1820
ISW=2 DMLS1830
GOTO 17 DMLS1840
C DMLS1850
C PERFORM STEP (8) DMLS1860
29 ISW=3 DMLS1870
GOTO 16 DMLS1880
C DMLS1890
C REINTERCHANGE CALCULATED SOLUTION DMLS1900
30 II=N DMLS1910
JJ=-1 DMLS1920
GOTO 4 DMLS1930
C DMLS1940
C ERROR RETURN IN CASE OF ZERO DIVISOR DMLS1950
31 IER=1 DMLS1960
32 RETURN DMLS1970
C DMLS1980
C ERROR RETURN IN CASE OF ILLEGAL DIMENSION DMLS1990
33 IER=-1 DMLS2000
RETURN DMLS2010
END DMLS2020