dlattp.f

来自「famous linear algebra library (LAPACK) p」· F 代码 · 共 743 行 · 第 1/2 页

                     A( JX+J-I ) = STEMP
                     JX = JX + N - I + 1
  160             CONTINUE
               END IF
*
*              Negate A(J+1,J).
*
               A( JC+1 ) = -A( JC+1 )
               JC = JCNEXT
  170       CONTINUE
         END IF
*
*     IMAT > 10:  Pathological test cases.  These triangular matrices
*     are badly scaled or badly conditioned, so when used in solving a
*     triangular system they may cause overflow in the solution vector.
*
      ELSE IF( IMAT.EQ.11 ) THEN
*
*        Type 11:  Generate a triangular matrix with elements between
*        -1 and 1. Give the diagonal norm 2 to make it well-conditioned.
*        Make the right hand side large so that it requires scaling.
*
         IF( UPPER ) THEN
            JC = 1
            DO 180 J = 1, N
               CALL DLARNV( 2, ISEED, J, A( JC ) )
               A( JC+J-1 ) = SIGN( TWO, A( JC+J-1 ) )
               JC = JC + J
  180       CONTINUE
         ELSE
            JC = 1
            DO 190 J = 1, N
               CALL DLARNV( 2, ISEED, N-J+1, A( JC ) )
               A( JC ) = SIGN( TWO, A( JC ) )
               JC = JC + N - J + 1
  190       CONTINUE
         END IF
*
*        Set the right hand side so that the largest value is BIGNUM.
*
         CALL DLARNV( 2, ISEED, N, B )
         IY = IDAMAX( N, B, 1 )
         BNORM = ABS( B( IY ) )
         BSCAL = BIGNUM / MAX( ONE, BNORM )
         CALL DSCAL( N, BSCAL, B, 1 )
*
      ELSE IF( IMAT.EQ.12 ) THEN
*
*        Type 12:  Make the first diagonal element in the solve small to
*        cause immediate overflow when dividing by T(j,j).
*        In type 12, the offdiagonal elements are small (CNORM(j) < 1).
*
         CALL DLARNV( 2, ISEED, N, B )
         TSCAL = ONE / MAX( ONE, DBLE( N-1 ) )
         IF( UPPER ) THEN
            JC = 1
            DO 200 J = 1, N
               CALL DLARNV( 2, ISEED, J-1, A( JC ) )
               CALL DSCAL( J-1, TSCAL, A( JC ), 1 )
               A( JC+J-1 ) = SIGN( ONE, DLARND( 2, ISEED ) )
               JC = JC + J
  200       CONTINUE
            A( N*( N+1 ) / 2 ) = SMLNUM
         ELSE
            JC = 1
            DO 210 J = 1, N
               CALL DLARNV( 2, ISEED, N-J, A( JC+1 ) )
               CALL DSCAL( N-J, TSCAL, A( JC+1 ), 1 )
               A( JC ) = SIGN( ONE, DLARND( 2, ISEED ) )
               JC = JC + N - J + 1
  210       CONTINUE
            A( 1 ) = SMLNUM
         END IF
*
      ELSE IF( IMAT.EQ.13 ) THEN
*
*        Type 13:  Make the first diagonal element in the solve small to
*        cause immediate overflow when dividing by T(j,j).
*        In type 13, the offdiagonal elements are O(1) (CNORM(j) > 1).
*
         CALL DLARNV( 2, ISEED, N, B )
         IF( UPPER ) THEN
            JC = 1
            DO 220 J = 1, N
               CALL DLARNV( 2, ISEED, J-1, A( JC ) )
               A( JC+J-1 ) = SIGN( ONE, DLARND( 2, ISEED ) )
               JC = JC + J
  220       CONTINUE
            A( N*( N+1 ) / 2 ) = SMLNUM
         ELSE
            JC = 1
            DO 230 J = 1, N
               CALL DLARNV( 2, ISEED, N-J, A( JC+1 ) )
               A( JC ) = SIGN( ONE, DLARND( 2, ISEED ) )
               JC = JC + N - J + 1
  230       CONTINUE
            A( 1 ) = SMLNUM
         END IF
*
      ELSE IF( IMAT.EQ.14 ) THEN
*
*        Type 14:  T is diagonal with small numbers on the diagonal to
*        make the growth factor underflow, but a small right hand side
*        chosen so that the solution does not overflow.
*
         IF( UPPER ) THEN
            JCOUNT = 1
            JC = ( N-1 )*N / 2 + 1
            DO 250 J = N, 1, -1
               DO 240 I = 1, J - 1
                  A( JC+I-1 ) = ZERO
  240          CONTINUE
               IF( JCOUNT.LE.2 ) THEN
                  A( JC+J-1 ) = SMLNUM
               ELSE
                  A( JC+J-1 ) = ONE
               END IF
               JCOUNT = JCOUNT + 1
               IF( JCOUNT.GT.4 )
     $            JCOUNT = 1
               JC = JC - J + 1
  250       CONTINUE
         ELSE
            JCOUNT = 1
            JC = 1
            DO 270 J = 1, N
               DO 260 I = J + 1, N
                  A( JC+I-J ) = ZERO
  260          CONTINUE
               IF( JCOUNT.LE.2 ) THEN
                  A( JC ) = SMLNUM
               ELSE
                  A( JC ) = ONE
               END IF
               JCOUNT = JCOUNT + 1
               IF( JCOUNT.GT.4 )
     $            JCOUNT = 1
               JC = JC + N - J + 1
  270       CONTINUE
         END IF
*
*        Set the right hand side alternately zero and small.
*
         IF( UPPER ) THEN
            B( 1 ) = ZERO
            DO 280 I = N, 2, -2
               B( I ) = ZERO
               B( I-1 ) = SMLNUM
  280       CONTINUE
         ELSE
            B( N ) = ZERO
            DO 290 I = 1, N - 1, 2
               B( I ) = ZERO
               B( I+1 ) = SMLNUM
  290       CONTINUE
         END IF
*
      ELSE IF( IMAT.EQ.15 ) THEN
*
*        Type 15:  Make the diagonal elements small to cause gradual
*        overflow when dividing by T(j,j).  To control the amount of
*        scaling needed, the matrix is bidiagonal.
*
         TEXP = ONE / MAX( ONE, DBLE( N-1 ) )
         TSCAL = SMLNUM**TEXP
         CALL DLARNV( 2, ISEED, N, B )
         IF( UPPER ) THEN
            JC = 1
            DO 310 J = 1, N
               DO 300 I = 1, J - 2
                  A( JC+I-1 ) = ZERO
  300          CONTINUE
               IF( J.GT.1 )
     $            A( JC+J-2 ) = -ONE
               A( JC+J-1 ) = TSCAL
               JC = JC + J
  310       CONTINUE
            B( N ) = ONE
         ELSE
            JC = 1
            DO 330 J = 1, N
               DO 320 I = J + 2, N
                  A( JC+I-J ) = ZERO
  320          CONTINUE
               IF( J.LT.N )
     $            A( JC+1 ) = -ONE
               A( JC ) = TSCAL
               JC = JC + N - J + 1
  330       CONTINUE
            B( 1 ) = ONE
         END IF
*
      ELSE IF( IMAT.EQ.16 ) THEN
*
*        Type 16:  One zero diagonal element.
*
         IY = N / 2 + 1
         IF( UPPER ) THEN
            JC = 1
            DO 340 J = 1, N
               CALL DLARNV( 2, ISEED, J, A( JC ) )
               IF( J.NE.IY ) THEN
                  A( JC+J-1 ) = SIGN( TWO, A( JC+J-1 ) )
               ELSE
                  A( JC+J-1 ) = ZERO
               END IF
               JC = JC + J
  340       CONTINUE
         ELSE
            JC = 1
            DO 350 J = 1, N
               CALL DLARNV( 2, ISEED, N-J+1, A( JC ) )
               IF( J.NE.IY ) THEN
                  A( JC ) = SIGN( TWO, A( JC ) )
               ELSE
                  A( JC ) = ZERO
               END IF
               JC = JC + N - J + 1
  350       CONTINUE
         END IF
         CALL DLARNV( 2, ISEED, N, B )
         CALL DSCAL( N, TWO, B, 1 )
*
      ELSE IF( IMAT.EQ.17 ) THEN
*
*        Type 17:  Make the offdiagonal elements large to cause overflow
*        when adding a column of T.  In the non-transposed case, the
*        matrix is constructed to cause overflow when adding a column in
*        every other step.
*
         TSCAL = UNFL / ULP
         TSCAL = ( ONE-ULP ) / TSCAL
         DO 360 J = 1, N*( N+1 ) / 2
            A( J ) = ZERO
  360    CONTINUE
         TEXP = ONE
         IF( UPPER ) THEN
            JC = ( N-1 )*N / 2 + 1
            DO 370 J = N, 2, -2
               A( JC ) = -TSCAL / DBLE( N+1 )
               A( JC+J-1 ) = ONE
               B( J ) = TEXP*( ONE-ULP )
               JC = JC - J + 1
               A( JC ) = -( TSCAL / DBLE( N+1 ) ) / DBLE( N+2 )
               A( JC+J-2 ) = ONE
               B( J-1 ) = TEXP*DBLE( N*N+N-1 )
               TEXP = TEXP*TWO
               JC = JC - J + 2
  370       CONTINUE
            B( 1 ) = ( DBLE( N+1 ) / DBLE( N+2 ) )*TSCAL
         ELSE
            JC = 1
            DO 380 J = 1, N - 1, 2
               A( JC+N-J ) = -TSCAL / DBLE( N+1 )
               A( JC ) = ONE
               B( J ) = TEXP*( ONE-ULP )
               JC = JC + N - J + 1
               A( JC+N-J-1 ) = -( TSCAL / DBLE( N+1 ) ) / DBLE( N+2 )
               A( JC ) = ONE
               B( J+1 ) = TEXP*DBLE( N*N+N-1 )
               TEXP = TEXP*TWO
               JC = JC + N - J
  380       CONTINUE
            B( N ) = ( DBLE( N+1 ) / DBLE( N+2 ) )*TSCAL
         END IF
*
      ELSE IF( IMAT.EQ.18 ) THEN
*
*        Type 18:  Generate a unit triangular matrix with elements
*        between -1 and 1, and make the right hand side large so that it
*        requires scaling.
*
         IF( UPPER ) THEN
            JC = 1
            DO 390 J = 1, N
               CALL DLARNV( 2, ISEED, J-1, A( JC ) )
               A( JC+J-1 ) = ZERO
               JC = JC + J
  390       CONTINUE
         ELSE
            JC = 1
            DO 400 J = 1, N
               IF( J.LT.N )
     $            CALL DLARNV( 2, ISEED, N-J, A( JC+1 ) )
               A( JC ) = ZERO
               JC = JC + N - J + 1
  400       CONTINUE
         END IF
*
*        Set the right hand side so that the largest value is BIGNUM.
*
         CALL DLARNV( 2, ISEED, N, B )
         IY = IDAMAX( N, B, 1 )
         BNORM = ABS( B( IY ) )
         BSCAL = BIGNUM / MAX( ONE, BNORM )
         CALL DSCAL( N, BSCAL, B, 1 )
*
      ELSE IF( IMAT.EQ.19 ) THEN
*
*        Type 19:  Generate a triangular matrix with elements between
*        BIGNUM/(n-1) and BIGNUM so that at least one of the column
*        norms will exceed BIGNUM.
*
         TLEFT = BIGNUM / MAX( ONE, DBLE( N-1 ) )
         TSCAL = BIGNUM*( DBLE( N-1 ) / MAX( ONE, DBLE( N ) ) )
         IF( UPPER ) THEN
            JC = 1
            DO 420 J = 1, N
               CALL DLARNV( 2, ISEED, J, A( JC ) )
               DO 410 I = 1, J
                  A( JC+I-1 ) = SIGN( TLEFT, A( JC+I-1 ) ) +
     $                          TSCAL*A( JC+I-1 )
  410          CONTINUE
               JC = JC + J
  420       CONTINUE
         ELSE
            JC = 1
            DO 440 J = 1, N
               CALL DLARNV( 2, ISEED, N-J+1, A( JC ) )
               DO 430 I = J, N
                  A( JC+I-J ) = SIGN( TLEFT, A( JC+I-J ) ) +
     $                          TSCAL*A( JC+I-J )
  430          CONTINUE
               JC = JC + N - J + 1
  440       CONTINUE
         END IF
         CALL DLARNV( 2, ISEED, N, B )
         CALL DSCAL( N, TWO, B, 1 )
      END IF
*
*     Flip the matrix across its counter-diagonal if the transpose will
*     be used.
*
      IF( .NOT.LSAME( TRANS, 'N' ) ) THEN
         IF( UPPER ) THEN
            JJ = 1
            JR = N*( N+1 ) / 2
            DO 460 J = 1, N / 2
               JL = JJ
               DO 450 I = J, N - J
                  T = A( JR-I+J )
                  A( JR-I+J ) = A( JL )
                  A( JL ) = T
                  JL = JL + I
  450          CONTINUE
               JJ = JJ + J + 1
               JR = JR - ( N-J+1 )
  460       CONTINUE
         ELSE
            JL = 1
            JJ = N*( N+1 ) / 2
            DO 480 J = 1, N / 2
               JR = JJ
               DO 470 I = J, N - J
                  T = A( JL+I-J )
                  A( JL+I-J ) = A( JR )
                  A( JR ) = T
                  JR = JR - I
  470          CONTINUE
               JL = JL + N - J + 1
               JJ = JJ - J - 1
  480       CONTINUE
         END IF
      END IF
*
      RETURN
*
*     End of DLATTP
*
      END