55
   56
   57
   58
   59
   60
   61      INTEGER            NIN, NOUT
   62
   63
   64
   65
   66
   67      INTEGER            LDE
   69      REAL               ZERO
   70      parameter( zero = 0.0e0 )
   71
   72
   73      INTEGER            I, IHI, ILO, INFO, J, KNT, N, NINFO
   74      REAL               EPS, RMAX, SAFMIN, VMAX, X
   75      COMPLEX            CDUM
   76
   77
   78      INTEGER            LMAX( 2 )
   79      REAL               SCALE( LDE )
   80      COMPLEX            E( LDE, LDE ), EIN( LDE, LDE )
   81
   82
   83      REAL               SLAMCH
   85
   86
   88
   89
   90      INTRINSIC          abs, aimag, max, real
   91
   92
   93      REAL               CABS1
   94
   95
   96      cabs1( cdum ) = abs( real( cdum ) ) + abs( aimag( cdum ) )
   97
   98
   99
  100      lmax( 1 ) = 0
  101      lmax( 2 ) = 0
  102      ninfo = 0
  103      knt = 0
  104      rmax = zero
  107
  108   10 CONTINUE
  109
  110      READ( nin, fmt = * )n, ilo, ihi
  111      IF( n.EQ.0 )
  112     $   GO TO 60
  113
  114      READ( nin, fmt = * )( scale( i ), i = 1, n )
  115      DO 20 i = 1, n
  116         READ( nin, fmt = * )( e( i, j ), j = 1, n )
  117   20 CONTINUE
  118
  119      DO 30 i = 1, n
  120         READ( nin, fmt = * )( ein( i, j ), j = 1, n )
  121   30 CONTINUE
  122
  123      knt = knt + 1
  124      CALL cgebak( 
'B', 
'R', n, ilo, ihi, scale, n, e, 
lde, info )
 
  125
  126      IF( info.NE.0 ) THEN
  127         ninfo = ninfo + 1
  128         lmax( 1 ) = knt
  129      END IF
  130
  131      vmax = zero
  132      DO 50 i = 1, n
  133         DO 40 j = 1, n
  134            x = cabs1( e( i, j )-ein( i, j ) ) / eps
  135            IF( cabs1( e( i, j ) ).GT.safmin )
  136     $         x = x / cabs1( e( i, j ) )
  137            vmax = max( vmax, x )
  138   40    CONTINUE
  139   50 CONTINUE
  140
  141      IF( vmax.GT.rmax ) THEN
  142         lmax( 2 ) = knt
  143         rmax = vmax
  144      END IF
  145
  146      GO TO 10
  147
  148   60 CONTINUE
  149
  150      WRITE( nout, fmt = 9999 )
  151 9999 FORMAT( 1x, '.. test output of CGEBAK .. ' )
  152
  153      WRITE( nout, fmt = 9998 )rmax
  154 9998 FORMAT( 1x, 'value of largest test error             = ', e12.3 )
  155      WRITE( nout, fmt = 9997 )lmax( 1 )
  156 9997 FORMAT( 1x, 'example number where info is not zero   = ', i4 )
  157      WRITE( nout, fmt = 9996 )lmax( 2 )
  158 9996 FORMAT( 1x, 'example number having largest error     = ', i4 )
  159      WRITE( nout, fmt = 9995 )ninfo
  160 9995 FORMAT( 1x, 'number of examples where info is not 0  = ', i4 )
  161      WRITE( nout, fmt = 9994 )knt
  162 9994 FORMAT( 1x, 'total number of examples tested         = ', i4 )
  163
  164      RETURN
  165
  166
  167
logical function lde(ri, rj, lr)
subroutine cgebak(job, side, n, ilo, ihi, scale, m, v, ldv, info)
CGEBAK
real function slamch(cmach)
SLAMCH