Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-02 - 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