Web pdp-10.trailing-edge.com

Trailing-Edge - PDP-10 Archives - decus_20tap2_198111 - decus/20-0026/dmtds.ssp
There are 2 other files named dmtds.ssp in the archive. Click here to see a list.
```C                                                                       DMTD  10
C     ..................................................................DMTD  20
C                                                                       DMTD  30
C        SUBROUTINE DMTDS                                               DMTD  40
C                                                                       DMTD  50
C        PURPOSE                                                        DMTD  60
C           MULTIPLY A GENERAL MATRIX A ON THE LEFT OR RIGHT BY         DMTD  70
C           INVERSE(T),INVERSE(TRANSPOSE(T)) OR INVERSE(TRANSPOSE(T*T)) DMTD  80
C           THE TRIANGULAR MATRIX T IS STORED COLUMNWISE IN COMPRESSED  DMTD  90
C           FORM, I.E. UPPER TRIANGULAR PART ONLY.                      DMTD 100
C                                                                       DMTD 110
C        USAGE                                                          DMTD 120
C           CALL DMTDS(A,M,N,T,IOP,IER)                                 DMTD 130
C                                                                       DMTD 140
C        DESCRIPTION OF PARAMETERS                                      DMTD 150
C           A     - GIVEN GENERAL MATRIX WITH  M ROWS AND N COLUMNS.    DMTD 160
C                   A MUST BE OF DOUBLE PRECISION                       DMTD 170
C           M     - NUMBER OF ROWS OF MATRIX A                          DMTD 180
C           N     - NUMBER OF COLUMNS OF MATRIX A                       DMTD 190
C           T     - GIVEN TRIANGULAR MATRIX STORED COLUMNWISE UPPER     DMTD 200
C                   TRIANGULAR PART ONLY. ITS NUMBER OF ROWS AND        DMTD 210
C                   COLUMNS K IS IMPLIED BY COMPATIBILITY.              DMTD 220
C                   K = M IF IOP IS POSITIVE,                           DMTD 230
C                   K = N IF IOP IS NEGATIVE.                           DMTD 240
C                   T OCCUPIES K*(K+1)/2 STORAGE POSITIONS.             DMTD 250
C                   T MUST BE OF DOUBLE PRECISION                       DMTD 260
C           IOP   - INPUT VARIABLE FOR SELECTION OF OPERATION           DMTD 270
C                   IOP = 1 - A IS REPLACED BY INVERSE(T)*A             DMTD 280
C                   IOP =-1 - A IS REPLACED BY A*INVERSE(T)             DMTD 290
C                   IOP = 2 - A IS REPLACED BY INVERSE(TRANSPOSE(T))*A  DMTD 300
C                   IOP =-2 - A IS REPLACED BY A*INVERSE(TRANSPOSE(T))  DMTD 310
C                   IOP = 3 - A IS REPLACED BY INVERSE(TRANSPOSE(T)*T)*ADMTD 320
C                   IOP =-3 - A IS REPLACED BY A*INVERSE(TRANSPOSE(T)*T)DMTD 330
C           IER   - RESULTING ERROR PARAMETER                           DMTD 340
C                   IER =-1 MEANS M AND N ARE NOT BOTH POSITIVE         DMTD 350
C                                 AND/OR IOP IS ILLEGAL                 DMTD 360
C                   IER = 0 MEANS OPERATION WAS SUCCESSFUL              DMTD 370
C                   IER = 1 MEANS TRIANGULAR MATRIX T IS SINGULAR       DMTD 380
C                                                                       DMTD 390
C        REMARKS                                                        DMTD 400
C           SUBROUTINE DMTDS MAY BE USED TO CALCULATE THE SOLUTION OF   DMTD 410
C           A SYSTEM OF EQUATIONS WITH SYMMETRIC POSITIVE DEFINITE      DMTD 420
C           COEFFICIENT MATRIX. THE FIRST STEP TOWARDS THE SOLUTION     DMTD 430
C           IS TRIANGULAR FACTORIZATION BY MEANS OF DMFSD, THE SECOND   DMTD 440
C           STEP IS APPLICATION OF DMTDS.                               DMTD 450
C           SUBROUTINES DMFSD AND DMTDS MAY BE USED IN ORDER TO         DMTD 460
C           CACULATE THE PRODUCT TRANSPOSE(A)*INVERSE(B)*A WITH GIVEN   DMTD 470
C           SYMMETRIC POSITIVE DEFINITE B AND GIVEN A IN THREE STEPS    DMTD 480
C           1) TRIANGULAR FACTORIZATION OF B (B=TRANSPOSE(T)*T)         DMTD 490
C           2) MULTIPLICATION OF A ON THE LEFT BY INVERSE(TRANSPOSE(T)) DMTD 500
C              A IS REPLACED BY C=INVERSE(TRANSPOSE(T))*A               DMTD 510
C           3) CALCULATION OF THE RESULT FORMING TRANSPOSE(C)*C         DMTD 520
C                                                                       DMTD 530
C        SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED                  DMTD 540
C           NONE                                                        DMTD 550
C                                                                       DMTD 560
C        METHOD                                                         DMTD 570
C           CALCULATION OF X = INVERSE(T)*A IS DONE USING BACKWARD      DMTD 580
C           SUBSTITUTION TO OBTAIN X FROM T*X = A.                      DMTD 590
C           CALCULATION OF Y = INVERSE(TRANSPOSE(T))*A IS DONE USING    DMTD 600
C           FORWARD SUBSTITUTION TO OBTAIN Y FROM TRANSPOSE(T)*Y = A.   DMTD 610
C           CALCULATION OF Z = INVERSE(TRANSPOSE(T)*T)*A IS DONE        DMTD 620
C           SOLVING FIRST TRANSPOSE(T)*Y = A AND THEN T*Z = Y, IE.      DMTD 630
C           USING THE ABOVE TWO STEPS IN REVERSE ORDER                  DMTD 640
C                                                                       DMTD 650
C     ..................................................................DMTD 660
C                                                                       DMTD 670
SUBROUTINE DMTDS(A,M,N,T,IOP,IER)                                 DMTD 680
C                                                                       DMTD 690
C                                                                       DMTD 700
DIMENSION A(1),T(1)                                               DMTD 710
DOUBLE PRECISION DSUM,A,T                                         DMTD 720
C                                                                       DMTD 730
C        TEST OF DIMENSION                                              DMTD 740
IF(M)2,2,1                                                        DMTD 750
1 IF(N)2,2,4                                                        DMTD 760
C                                                                       DMTD 770
C        ERROR RETURN IN CASE OF ILLEGAL DIMENSIONS                     DMTD 780
2 IER=-1                                                            DMTD 790
RETURN                                                            DMTD 800
C                                                                       DMTD 810
C        ERROR RETURN IN CASE OF SINGULAR MATRIX T                      DMTD 820
3 IER=1                                                             DMTD 830
RETURN                                                            DMTD 840
C                                                                       DMTD 850
C        INITIALIZE DIVISION PROCESS                                    DMTD 860
4 MN=M*N                                                            DMTD 870
MM=M*(M+1)/2                                                      DMTD 880
MM1=M-1                                                           DMTD 890
IER=0                                                             DMTD 900
ICS=M                                                             DMTD 910
IRS=1                                                             DMTD 920
IMEND=M                                                           DMTD 930
C                                                                       DMTD 940
C        TEST SPECIFIED OPERATION                                       DMTD 950
IF(IOP)5,2,6                                                      DMTD 960
5 MM=N*(N+1)/2                                                      DMTD 970
MM1=N-1                                                           DMTD 980
IRS=M                                                             DMTD 990
ICS=1                                                             DMTD1000
IMEND=MN-M+1                                                      DMTD1010
MN=M                                                              DMTD1020
6 IOPE=MOD(IOP+3,3)                                                 DMTD1030
IF(IABS(IOP)-3)7,7,2                                              DMTD1040
7 IF(IOPE-1)8,18,8                                                  DMTD1050
C                                                                       DMTD1060
C        INITIALIZE SOLUTION OF TRANSPOSE(T)*X = A                      DMTD1070
8 MEND=1                                                            DMTD1080
LLD=IRS                                                           DMTD1090
MSTA=1                                                            DMTD1100
MDEL=1                                                            DMTD1110
MX=1                                                              DMTD1120
LD=1                                                              DMTD1130
LX=0                                                              DMTD1140
C                                                                       DMTD1150
C        TEST FOR NONZERO DIAGONAL TERM IN T                            DMTD1160
9 IF(T(MSTA))10,3,10                                                DMTD1170
10 DO 11 I=MEND,MN,ICS                                               DMTD1180
11 A(I)=A(I)/T(MSTA)                                                 DMTD1190
C                                                                       DMTD1200
C        IS M EQUAL 1                                                   DMTD1210
IF(MM1)2,15,12                                                    DMTD1220
12 DO 14 J=1,MM1                                                     DMTD1230
MSTA=MSTA+MDEL                                                    DMTD1240
MDEL=MDEL+MX                                                      DMTD1250
DO 14 I=MEND,MN,ICS                                               DMTD1260
DSUM=0.D0                                                         DMTD1270
L=MSTA                                                            DMTD1280
LDX=LD                                                            DMTD1290
LL=I                                                              DMTD1300
DO 13 K=1,J                                                       DMTD1310
DSUM=DSUM-T(L)*A(LL)                                              DMTD1320
LL=LL+LLD                                                         DMTD1330
L=L+LDX                                                           DMTD1340
13 LDX=LDX+LX                                                        DMTD1350
IF(T(L))14,3,14                                                   DMTD1360
14 A(LL)=(DSUM+A(LL))/T(L)                                           DMTD1370
C                                                                       DMTD1380
C        TEST END OF OPERATION                                          DMTD1390
15 IF(IER)16,17,16                                                   DMTD1400
16 IER=0                                                             DMTD1410
RETURN                                                            DMTD1420
17 IF(IOPE)18,18,16                                                  DMTD1430
C                                                                       DMTD1440
C        INITIALIZE SOLUTION OF T*X = A                                 DMTD1450
18 IER=1                                                             DMTD1460
MEND=IMEND                                                        DMTD1470
MN=M*N                                                            DMTD1480
LLD=-IRS                                                          DMTD1490
MSTA=MM                                                           DMTD1500
MDEL=-1                                                           DMTD1510
MX=0                                                              DMTD1520
LD=-MM1                                                           DMTD1530
LX=1                                                              DMTD1540
GOTO 9                                                            DMTD1550
END                                                               DMTD1560

```