Return to wgedi.f CVS log

Up to [Research Unix] / researchv10dc / cmd / matlab / src

Annotation of researchv10dc/cmd/matlab/src/wgedi.f, revision 1.1

1.1     ! root        1:       SUBROUTINE WGEDI(AR,AI,LDA,N,IPVT,DETR,DETI,WORKR,WORKI,JOB)
        !             2:       INTEGER LDA,N,IPVT(1),JOB
        !             3:       DOUBLE PRECISION AR(LDA,1),AI(LDA,1),DETR(2),DETI(2),WORKR(1),
        !             4:      *                 WORKI(1)
        !             5: C
        !             6: C     WGEDI COMPUTES THE DETERMINANT AND INVERSE OF A MATRIX
        !             7: C     USING THE FACTORS COMPUTED BY WGECO OR WGEFA.
        !             8: C
        !             9: C     ON ENTRY
        !            10: C
        !            11: C        A       DOUBLE-COMPLEX(LDA, N)
        !            12: C                THE OUTPUT FROM WGECO OR WGEFA.
        !            13: C
        !            14: C        LDA     INTEGER
        !            15: C                THE LEADING DIMENSION OF THE ARRAY  A .
        !            16: C
        !            17: C        N       INTEGER
        !            18: C                THE ORDER OF THE MATRIX  A .
        !            19: C
        !            20: C        IPVT    INTEGER(N)
        !            21: C                THE PIVOT VECTOR FROM WGECO OR WGEFA.
        !            22: C
        !            23: C        WORK    DOUBLE-COMPLEX(N)
        !            24: C                WORK VECTOR.  CONTENTS DESTROYED.
        !            25: C
        !            26: C        JOB     INTEGER
        !            27: C                = 11   BOTH DETERMINANT AND INVERSE.
        !            28: C                = 01   INVERSE ONLY.
        !            29: C                = 10   DETERMINANT ONLY.
        !            30: C
        !            31: C     ON RETURN
        !            32: C
        !            33: C        A       INVERSE OF ORIGINAL MATRIX IF REQUESTED.
        !            34: C                OTHERWISE UNCHANGED.
        !            35: C
        !            36: C        DET     DOUBLE-COMPLEX(2)
        !            37: C                DETERMINANT OF ORIGINAL MATRIX IF REQUESTED.
        !            38: C                OTHERWISE NOT REFERENCED.
        !            39: C                DETERMINANT = DET(1) * 10.0**DET(2)
        !            40: C                WITH  1.0 .LE. CABS1(DET(1) .LT. 10.0
        !            41: C                OR  DET(1) .EQ. 0.0 .
        !            42: C
        !            43: C     ERROR CONDITION
        !            44: C
        !            45: C        A DIVISION BY ZERO WILL OCCUR IF THE INPUT FACTOR CONTAINS
        !            46: C        A ZERO ON THE DIAGONAL AND THE INVERSE IS REQUESTED.
        !            47: C        IT WILL NOT OCCUR IF THE SUBROUTINES ARE CALLED CORRECTLY
        !            48: C        AND IF WGECO HAS SET RCOND .GT. 0.0 OR WGEFA HAS SET
        !            49: C        INFO .EQ. 0 .
        !            50: C
        !            51: C     LINPACK. THIS VERSION DATED 07/01/79 .
        !            52: C     CLEVE MOLER, UNIVERSITY OF NEW MEXICO, ARGONNE NATIONAL LAB.
        !            53: C
        !            54: C     SUBROUTINES AND FUNCTIONS
        !            55: C
        !            56: C     BLAS WAXPY,WSCAL,WSWAP
        !            57: C     FORTRAN DABS,MOD
        !            58: C
        !            59: C     INTERNAL VARIABLES
        !            60: C
        !            61:       DOUBLE PRECISION TR,TI
        !            62:       DOUBLE PRECISION TEN
        !            63:       INTEGER I,J,K,KB,KP1,L,NM1
        !            64: C
        !            65:       DOUBLE PRECISION ZDUMR,ZDUMI
        !            66:       DOUBLE PRECISION CABS1
        !            67:       CABS1(ZDUMR,ZDUMI) = DABS(ZDUMR) + DABS(ZDUMI)
        !            68: C
        !            69: C     COMPUTE DETERMINANT
        !            70: C
        !            71:       IF (JOB/10 .EQ. 0) GO TO 80
        !            72:          DETR(1) = 1.0D0
        !            73:          DETI(1) = 0.0D0
        !            74:          DETR(2) = 0.0D0
        !            75:          DETI(2) = 0.0D0
        !            76:          TEN = 10.0D0
        !            77:          DO 60 I = 1, N
        !            78:             IF (IPVT(I) .EQ. I) GO TO 10
        !            79:                DETR(1) = -DETR(1)
        !            80:                DETI(1) = -DETI(1)
        !            81:    10       CONTINUE
        !            82:             CALL WMUL(AR(I,I),AI(I,I),DETR(1),DETI(1),DETR(1),DETI(1))
        !            83: C           ...EXIT
        !            84: C        ...EXIT
        !            85:             IF (CABS1(DETR(1),DETI(1)) .EQ. 0.0D0) GO TO 70
        !            86:    20       IF (CABS1(DETR(1),DETI(1)) .GE. 1.0D0) GO TO 30
        !            87:                DETR(1) = TEN*DETR(1)
        !            88:                DETI(1) = TEN*DETI(1)
        !            89:                DETR(2) = DETR(2) - 1.0D0
        !            90:                DETI(2) = DETI(2) - 0.0D0
        !            91:             GO TO 20
        !            92:    30       CONTINUE
        !            93:    40       IF (CABS1(DETR(1),DETI(1)) .LT. TEN) GO TO 50
        !            94:                DETR(1) = DETR(1)/TEN
        !            95:                DETI(1) = DETI(1)/TEN
        !            96:                DETR(2) = DETR(2) + 1.0D0
        !            97:                DETI(2) = DETI(2) + 0.0D0
        !            98:             GO TO 40
        !            99:    50       CONTINUE
        !           100:    60    CONTINUE
        !           101:    70    CONTINUE
        !           102:    80 CONTINUE
        !           103: C
        !           104: C     COMPUTE INVERSE(U)
        !           105: C
        !           106:       IF (MOD(JOB,10) .EQ. 0) GO TO 160
        !           107:          DO 110 K = 1, N
        !           108:             CALL WDIV(1.0D0,0.0D0,AR(K,K),AI(K,K),AR(K,K),AI(K,K))
        !           109:             TR = -AR(K,K)
        !           110:             TI = -AI(K,K)
        !           111:             CALL WSCAL(K-1,TR,TI,AR(1,K),AI(1,K),1)
        !           112:             KP1 = K + 1
        !           113:             IF (N .LT. KP1) GO TO 100
        !           114:             DO 90 J = KP1, N
        !           115:                TR = AR(K,J)
        !           116:                TI = AI(K,J)
        !           117:                AR(K,J) = 0.0D0
        !           118:                AI(K,J) = 0.0D0
        !           119:                CALL WAXPY(K,TR,TI,AR(1,K),AI(1,K),1,AR(1,J),AI(1,J),1)
        !           120:    90       CONTINUE
        !           121:   100       CONTINUE
        !           122:   110    CONTINUE
        !           123: C
        !           124: C        FORM INVERSE(U)*INVERSE(L)
        !           125: C
        !           126:          NM1 = N - 1
        !           127:          IF (NM1 .LT. 1) GO TO 150
        !           128:          DO 140 KB = 1, NM1
        !           129:             K = N - KB
        !           130:             KP1 = K + 1
        !           131:             DO 120 I = KP1, N
        !           132:                WORKR(I) = AR(I,K)
        !           133:                WORKI(I) = AI(I,K)
        !           134:                AR(I,K) = 0.0D0
        !           135:                AI(I,K) = 0.0D0
        !           136:   120       CONTINUE
        !           137:             DO 130 J = KP1, N
        !           138:                TR = WORKR(J)
        !           139:                TI = WORKI(J)
        !           140:                CALL WAXPY(N,TR,TI,AR(1,J),AI(1,J),1,AR(1,K),AI(1,K),1)
        !           141:   130       CONTINUE
        !           142:             L = IPVT(K)
        !           143:             IF (L .NE. K)
        !           144:      *         CALL WSWAP(N,AR(1,K),AI(1,K),1,AR(1,L),AI(1,L),1)
        !           145:   140    CONTINUE
        !           146:   150    CONTINUE
        !           147:   160 CONTINUE
        !           148:       RETURN
        !           149:       END

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.