Trailing-Edge
-
PDP-10 Archives
-
decuslib20-02
-
decus/20-0026/mfgr.ssp
There are 2 other files named mfgr.ssp in the archive. Click here to see a list.
C MFGR 10
C ..................................................................MFGR 20
C MFGR 30
C SUBROUTINE MFGR MFGR 40
C MFGR 50
C PURPOSE MFGR 60
C FOR A GIVEN M BY N MATRIX THE FOLLOWING CALCULATIONS MFGR 70
C ARE PERFORMED MFGR 80
C (1) DETERMINE RANK AND LINEARLY INDEPENDENT ROWS AND MFGR 90
C COLUMNS (BASIS). MFGR 100
C (2) FACTORIZE A SUBMATRIX OF MAXIMAL RANK. MFGR 110
C (3) EXPRESS NON-BASIC ROWS IN TERMS OF BASIC ONES. MFGR 120
C (4) EXPRESS BASIC VARIABLES IN TERMS OF FREE ONES. MFGR 130
C MFGR 140
C USAGE MFGR 150
C CALL MFGR(A,M,N,EPS,IRANK,IROW,ICOL) MFGR 160
C MFGR 170
C DESCRIPTION OF PARAMETERS MFGR 180
C A - GIVEN MATRIX WITH M ROWS AND N COLUMNS. MFGR 190
C ON RETURN A CONTAINS THE FIVE SUBMATRICES MFGR 200
C L, R, H, D, O. MFGR 210
C M - NUMBER OF ROWS OF MATRIX A. MFGR 220
C N - NUMBER OF COLUMNS OF MATRIX A. MFGR 230
C EPS - TESTVALUE FOR ZERO AFFECTED BY ROUNDOFF NOISE. MFGR 240
C IRANK - RESULTANT RANK OF GIVEN MATRIX. MFGR 250
C IROW - INTEGER VECTOR OF DIMENSION M CONTAINING THE MFGR 260
C SUBSCRIPTS OF BASIC ROWS IN IROW(1),...,IROW(IRANK)MFGR 270
C ICOL - INTEGER VECTOR OF DIMENSION N CONTAINING THE MFGR 280
C SUBSCRIPTS OF BASIC COLUMNS IN ICOL(1) UP TO MFGR 290
C ICOL(IRANK). MFGR 300
C MFGR 310
C REMARKS MFGR 320
C THE LEFT HAND TRIANGULAR FACTOR IS NORMALIZED SUCH THAT MFGR 330
C THE DIAGONAL CONTAINS ALL ONES THUS ALLOWING TO STORE ONLY MFGR 340
C THE SUBDIAGONAL PART. MFGR 350
C MFGR 360
C SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED MFGR 370
C NONE MFGR 380
C MFGR 390
C METHOD MFGR 400
C GAUSSIAN ELIMINATION TECHNIQUE IS USED FOR CALCULATION MFGR 410
C OF THE TRIANGULAR FACTORS OF A GIVEN MATRIX. MFGR 420
C COMPLETE PIVOTING IS BUILT IN. MFGR 430
C IN CASE OF A SINGULAR MATRIX ONLY THE TRIANGULAR FACTORS MFGR 440
C OF A SUBMATRIX OF MAXIMAL RANK ARE RETAINED. MFGR 450
C THE REMAINING PARTS OF THE RESULTANT MATRIX GIVE THE MFGR 460
C DEPENDENCIES OF ROWS AND THE SOLUTION OF THE HOMOGENEOUS MFGR 470
C MATRIX EQUATION A*X=0. MFGR 480
C MFGR 490
C ..................................................................MFGR 500
C MFGR 510
SUBROUTINE MFGR(A,M,N,EPS,IRANK,IROW,ICOL) MFGR 520
C MFGR 530
C DIMENSIONED DUMMY VARIABLES MFGR 540
DIMENSION A(1),IROW(1),ICOL(1) MFGR 550
C MFGR 560
C TEST OF SPECIFIED DIMENSIONS MFGR 570
IF(M)2,2,1 MFGR 580
1 IF(N)2,2,4 MFGR 590
2 IRANK=-1 MFGR 600
3 RETURN MFGR 610
C RETURN IN CASE OF FORMAL ERRORS MFGR 620
C MFGR 630
C MFGR 640
C INITIALIZE COLUMN INDEX VECTOR MFGR 650
C SEARCH FIRST PIVOT ELEMENT MFGR 660
4 IRANK=0 MFGR 670
PIV=0. MFGR 680
JJ=0 MFGR 690
DO 6 J=1,N MFGR 700
ICOL(J)=J MFGR 710
DO 6 I=1,M MFGR 720
JJ=JJ+1 MFGR 730
HOLD=A(JJ) MFGR 740
IF(ABS(PIV)-ABS(HOLD))5,6,6 MFGR 750
5 PIV=HOLD MFGR 760
IR=I MFGR 770
IC=J MFGR 780
6 CONTINUE MFGR 790
C MFGR 800
C INITIALIZE ROW INDEX VECTOR MFGR 810
DO 7 I=1,M MFGR 820
7 IROW(I)=I MFGR 830
C MFGR 840
C SET UP INTERNAL TOLERANCE MFGR 850
TOL=ABS(EPS*PIV) MFGR 860
C MFGR 870
C INITIALIZE ELIMINATION LOOP MFGR 880
NM=N*M MFGR 890
DO 19 NCOL=M,NM,M MFGR 900
C MFGR 910
C TEST FOR FEASIBILITY OF PIVOT ELEMENT MFGR 920
8 IF(ABS(PIV)-TOL)20,20,9 MFGR 930
C MFGR 940
C UPDATE RANK MFGR 950
9 IRANK=IRANK+1 MFGR 960
C MFGR 970
C INTERCHANGE ROWS IF NECESSARY MFGR 980
JJ=IR-IRANK MFGR 990
IF(JJ)12,12,10 MFGR1000
10 DO 11 J=IRANK,NM,M MFGR1010
I=J+JJ MFGR1020
SAVE=A(J) MFGR1030
A(J)=A(I) MFGR1040
11 A(I)=SAVE MFGR1050
C MFGR1060
C UPDATE ROW INDEX VECTOR MFGR1070
JJ=IROW(IR) MFGR1080
IROW(IR)=IROW(IRANK) MFGR1090
IROW(IRANK)=JJ MFGR1100
C MFGR1110
C INTERCHANGE COLUMNS IF NECESSARY MFGR1120
12 JJ=(IC-IRANK)*M MFGR1130
IF(JJ)15,15,13 MFGR1140
13 KK=NCOL MFGR1150
DO 14 J=1,M MFGR1160
I=KK+JJ MFGR1170
SAVE=A(KK) MFGR1180
A(KK)=A(I) MFGR1190
KK=KK-1 MFGR1200
14 A(I)=SAVE MFGR1210
C MFGR1220
C UPDATE COLUMN INDEX VECTOR MFGR1230
JJ=ICOL(IC) MFGR1240
ICOL(IC)=ICOL(IRANK) MFGR1250
ICOL(IRANK)=JJ MFGR1260
15 KK=IRANK+1 MFGR1270
MM=IRANK-M MFGR1280
LL=NCOL+MM MFGR1290
C MFGR1300
C TEST FOR LAST ROW MFGR1310
IF(MM)16,25,25 MFGR1320
C MFGR1330
C TRANSFORM CURRENT SUBMATRIX AND SEARCH NEXT PIVOT MFGR1340
16 JJ=LL MFGR1350
SAVE=PIV MFGR1360
PIV=0. MFGR1370
DO 19 J=KK,M MFGR1380
JJ=JJ+1 MFGR1390
HOLD=A(JJ)/SAVE MFGR1400
A(JJ)=HOLD MFGR1410
L=J-IRANK MFGR1420
C MFGR1430
C TEST FOR LAST COLUMN MFGR1440
IF(IRANK-N)17,19,19 MFGR1450
17 II=JJ MFGR1460
DO 19 I=KK,N MFGR1470
II=II+M MFGR1480
MM=II-L MFGR1490
A(II)=A(II)-HOLD*A(MM) MFGR1500
IF(ABS(A(II))-ABS(PIV))19,19,18 MFGR1510
18 PIV=A(II) MFGR1520
IR=J MFGR1530
IC=I MFGR1540
19 CONTINUE MFGR1550
C MFGR1560
C SET UP MATRIX EXPRESSING ROW DEPENDENCIES MFGR1570
20 IF(IRANK-1)3,25,21 MFGR1580
21 IR=LL MFGR1590
DO 24 J=2,IRANK MFGR1600
II=J-1 MFGR1610
IR=IR-M MFGR1620
JJ=LL MFGR1630
DO 23 I=KK,M MFGR1640
HOLD=0. MFGR1650
JJ=JJ+1 MFGR1660
MM=JJ MFGR1670
IC=IR MFGR1680
DO 22 L=1,II MFGR1690
HOLD=HOLD+A(MM)*A(IC) MFGR1700
IC=IC-1 MFGR1710
22 MM=MM-M MFGR1720
23 A(MM)=A(MM)-HOLD MFGR1730
24 CONTINUE MFGR1740
C MFGR1750
C TEST FOR COLUMN REGULARITY MFGR1760
25 IF(N-IRANK)3,3,26 MFGR1770
C MFGR1780
C SET UP MATRIX EXPRESSING BASIC VARIABLES IN TERMS OF FREE MFGR1790
C PARAMETERS (HOMOGENEOUS SOLUTION). MFGR1800
26 IR=LL MFGR1810
KK=LL+M MFGR1820
DO 30 J=1,IRANK MFGR1830
DO 29 I=KK,NM,M MFGR1840
JJ=IR MFGR1850
LL=I MFGR1860
HOLD=0. MFGR1870
II=J MFGR1880
27 II=II-1 MFGR1890
IF(II)29,29,28 MFGR1900
28 HOLD=HOLD-A(JJ)*A(LL) MFGR1910
JJ=JJ-M MFGR1920
LL=LL-1 MFGR1930
GOTO 27 MFGR1940
29 A(LL)=(HOLD-A(LL))/A(JJ) MFGR1950
30 IR=IR-1 MFGR1960
RETURN MFGR1970
END MFGR1980