Browse Files
       1
       2
       3
       4
       5
       6
       7
       8
       9
      10
      11
      12
      13
      14
      15
      16
      17
      18
      19
      20
      21
      22
      23
      24
      25
      26
      27
      28
      29
      30
      31
      32
      33
      34
      35
      36
      37
      38
      39
      40
      41
      42
      43
      44
      45
      46
      47
      48
      49
      50
      51
      52
      53
      54
      55
      56
      57
      58
      59
      60
      61
      62
      63
      64
      65
      66
      67
      68
      69
      70
      71
      72
      73
      74
      75
      76
      77
      78
      79
      80
      81
      82
      83
      84
      85
      86
      87
      88
      89
      90
      91
      92
      93
      94
      95
      96
      97
      98
      99
     100
     101
     102
     103
     104
     105
     106
     107
     108
     109
     110
     111
     112
     113
     114
     115
     116
     117
     118
     119
     120
     121
     122
     123
     124
     125
     126
     127
     128
     129
     130
     131
     132
     133
     134
     135
     136
     137
     138
     139
     140
     141
     142
     143
     144
     145
     146
     147
     148
     149
     150
     151
      SUBROUTINE DCHKGL( NIN, NOUT )
*
*  -- LAPACK test routine (version 3.1) --
*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
*     November 2006
*
*     .. Scalar Arguments ..
      INTEGER            NIN, NOUT
*     ..
*
*  Purpose
*  =======
*
*  DCHKGL tests DGGBAL, a routine for balancing a matrix pair (A, B).
*
*  Arguments
*  =========
*
*  NIN     (input) INTEGER
*          The logical unit number for input.  NIN > 0.
*
*  NOUT    (input) INTEGER
*          The logical unit number for output.  NOUT > 0.
*
*  =====================================================================
*
*     .. Parameters ..
      INTEGER            LDA, LDB, LWORK
      PARAMETER          ( LDA = 20, LDB = 20, LWORK = 6*LDA )
      DOUBLE PRECISION   ZERO
      PARAMETER          ( ZERO = 0.0D+0 )
*     ..
*     .. Local Scalars ..
      INTEGER            I, IHI, IHIIN, ILO, ILOIN, INFO, J, KNT, N,
     $                   NINFO
      DOUBLE PRECISION   ANORM, BNORM, EPS, RMAX, VMAX
*     ..
*     .. Local Arrays ..
      INTEGER            LMAX( 5 )
      DOUBLE PRECISION   A( LDA, LDA ), AIN( LDA, LDA ), B( LDB, LDB ),
     $                   BIN( LDB, LDB ), LSCALE( LDA ), LSCLIN( LDA ),
     $                   RSCALE( LDA ), RSCLIN( LDA ), WORK( LWORK )
*     ..
*     .. External Functions ..
      DOUBLE PRECISION   DLAMCH, DLANGE
      EXTERNAL           DLAMCH, DLANGE
*     ..
*     .. External Subroutines ..
      EXTERNAL           DGGBAL
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          ABS, MAX
*     ..
*     .. Executable Statements ..
*
      LMAX( 1 ) = 0
      LMAX( 2 ) = 0
      LMAX( 3 ) = 0
      NINFO = 0
      KNT = 0
      RMAX = ZERO
*
      EPS = DLAMCH( 'Precision' )
*
   10 CONTINUE
*
      READ( NIN, FMT = * )N
      IF( N.EQ.0 )
     $   GO TO 90
      DO 20 I = 1, N
         READ( NIN, FMT = * )( A( I, J ), J = 1, N )
   20 CONTINUE
*
      DO 30 I = 1, N
         READ( NIN, FMT = * )( B( I, J ), J = 1, N )
   30 CONTINUE
*
      READ( NIN, FMT = * )ILOIN, IHIIN
      DO 40 I = 1, N
         READ( NIN, FMT = * )( AIN( I, J ), J = 1, N )
   40 CONTINUE
      DO 50 I = 1, N
         READ( NIN, FMT = * )( BIN( I, J ), J = 1, N )
   50 CONTINUE
*
      READ( NIN, FMT = * )( LSCLIN( I ), I = 1, N )
      READ( NIN, FMT = * )( RSCLIN( I ), I = 1, N )
*
      ANORM = DLANGE( 'M', N, N, A, LDA, WORK )
      BNORM = DLANGE( 'M', N, N, B, LDB, WORK )
*
      KNT = KNT + 1
*
      CALL DGGBAL( 'B', N, A, LDA, B, LDB, ILO, IHI, LSCALE, RSCALE,
     $             WORK, INFO )
*
      IF( INFO.NE.0 ) THEN
         NINFO = NINFO + 1
         LMAX( 1 ) = KNT
      END IF
*
      IF( ILO.NE.ILOIN .OR. IHI.NE.IHIIN ) THEN
         NINFO = NINFO + 1
         LMAX( 2 ) = KNT
      END IF
*
      VMAX = ZERO
      DO 70 I = 1, N
         DO 60 J = 1, N
            VMAX = MAX( VMAX, ABS( A( I, J )-AIN( I, J ) ) )
            VMAX = MAX( VMAX, ABS( B( I, J )-BIN( I, J ) ) )
   60    CONTINUE
   70 CONTINUE
*
      DO 80 I = 1, N
         VMAX = MAX( VMAX, ABS( LSCALE( I )-LSCLIN( I ) ) )
         VMAX = MAX( VMAX, ABS( RSCALE( I )-RSCLIN( I ) ) )
   80 CONTINUE
*
      VMAX = VMAX / ( EPS*MAX( ANORM, BNORM ) )
*
      IF( VMAX.GT.RMAX ) THEN
         LMAX( 3 ) = KNT
         RMAX = VMAX
      END IF
*
      GO TO 10
*
   90 CONTINUE
*
      WRITE( NOUT, FMT = 9999 )
 9999 FORMAT( 1X, '.. test output of DGGBAL .. ' )
*
      WRITE( NOUT, FMT = 9998 )RMAX
 9998 FORMAT( 1X, 'value of largest test error            = ', D12.3 )
      WRITE( NOUT, FMT = 9997 )LMAX( 1 )
 9997 FORMAT( 1X, 'example number where info is not zero  = ', I4 )
      WRITE( NOUT, FMT = 9996 )LMAX( 2 )
 9996 FORMAT( 1X, 'example number where ILO or IHI wrong  = ', I4 )
      WRITE( NOUT, FMT = 9995 )LMAX( 3 )
 9995 FORMAT( 1X, 'example number having largest error    = ', I4 )
      WRITE( NOUT, FMT = 9994 )NINFO
 9994 FORMAT( 1X, 'number of examples where info is not 0 = ', I4 )
      WRITE( NOUT, FMT = 9993 )KNT
 9993 FORMAT( 1X, 'total number of examples tested        = ', I4 )
*
      RETURN
*
*     End of DCHKGL
*
      END