55      IMPLICIT NONE
   56
   57
   58
   59
   60
   61
   62      CHARACTER*3        PATH
   63      INTEGER            NUNIT
   64
   65
   66
   67
   68
   69      INTEGER            NMAX
   70      parameter( nmax = 2 )
   71
   72
   73      INTEGER            I, INFO, J
   74
   75
   76      DOUBLE PRECISION   A( NMAX, NMAX ), T( NMAX, NMAX ), W( NMAX ),
   77     $                   C( NMAX, NMAX )
   78
   79
   82
   83
   84      LOGICAL            LERR, OK
   85      CHARACTER*32       SRNAMT
   86      INTEGER            INFOT, NOUT
   87
   88
   89      COMMON             / infoc / infot, nout, ok, lerr
   90      COMMON             / srnamc / srnamt
   91
   92
   93      INTRINSIC          dble
   94
   95
   96
   97      nout = nunit
   98      WRITE( nout, fmt = * )
   99
  100
  101
  102      DO j = 1, nmax
  103         DO i = 1, nmax
  104            a( i, j ) = 1.d0 / dble( i+j )
  105            c( i, j ) = 1.d0 / dble( i+j )
  106            t( i, j ) = 1.d0 / dble( i+j )
  107         END DO
  108         w( j ) = 0.d0
  109      END DO
  110      ok = .true.
  111
  112
  113
  114
  115
  116      srnamt = 'DGELQT'
  117      infot = 1
  118      CALL dgelqt( -1, 0, 1, a, 1, t, 1, w, info )
 
  119      CALL chkxer( 
'DGELQT', infot, nout, lerr, ok )
 
  120      infot = 2
  121      CALL dgelqt( 0, -1, 1, a, 1, t, 1, w, info )
 
  122      CALL chkxer( 
'DGELQT', infot, nout, lerr, ok )
 
  123      infot = 3
  124      CALL dgelqt( 0, 0, 0, a, 1, t, 1, w, info )
 
  125      CALL chkxer( 
'DGELQT', infot, nout, lerr, ok )
 
  126      infot = 5
  127      CALL dgelqt( 2, 1, 1, a, 1, t, 1, w, info )
 
  128      CALL chkxer( 
'DGELQT', infot, nout, lerr, ok )
 
  129      infot = 7
  130      CALL dgelqt( 2, 2, 2, a, 2, t, 1, w, info )
 
  131      CALL chkxer( 
'DGELQT', infot, nout, lerr, ok )
 
  132
  133
  134
  135      srnamt = 'DGELQT3'
  136      infot = 1
  137      CALL dgelqt3( -1, 0, a, 1, t, 1, info )
 
  138      CALL chkxer( 
'DGELQT3', infot, nout, lerr, ok )
 
  139      infot = 2
  140      CALL dgelqt3( 0, -1, a, 1, t, 1, info )
 
  141      CALL chkxer( 
'DGELQT3', infot, nout, lerr, ok )
 
  142      infot = 4
  143      CALL dgelqt3( 2, 2, a, 1, t, 1, info )
 
  144      CALL chkxer( 
'DGELQT3', infot, nout, lerr, ok )
 
  145      infot = 6
  146      CALL dgelqt3( 2, 2, a, 2, t, 1, info )
 
  147      CALL chkxer( 
'DGELQT3', infot, nout, lerr, ok )
 
  148
  149
  150
  151      srnamt = 'DGEMLQT'
  152      infot = 1
  153      CALL dgemlqt( 
'/', 
'N', 0, 0, 0, 1, a, 1, t, 1, c, 1, w, info )
 
  154      CALL chkxer( 
'DGEMLQT', infot, nout, lerr, ok )
 
  155      infot = 2
  156      CALL dgemlqt( 
'L', 
'/', 0, 0, 0, 1, a, 1, t, 1, c, 1, w, info )
 
  157      CALL chkxer( 
'DGEMLQT', infot, nout, lerr, ok )
 
  158      infot = 3
  159      CALL dgemlqt( 
'L', 
'N', -1, 0, 0, 1, a, 1, t, 1, c, 1, w, info )
 
  160      CALL chkxer( 
'DGEMLQT', infot, nout, lerr, ok )
 
  161      infot = 4
  162      CALL dgemlqt( 
'L', 
'N', 0, -1, 0, 1, a, 1, t, 1, c, 1, w, info )
 
  163      CALL chkxer( 
'DGEMLQT', infot, nout, lerr, ok )
 
  164      infot = 5
  165      CALL dgemlqt( 
'L', 
'N', 0, 0, -1, 1, a, 1, t, 1, c, 1, w, info )
 
  166      CALL chkxer( 
'DGEMLQT', infot, nout, lerr, ok )
 
  167      infot = 5
  168      CALL dgemlqt( 
'R', 
'N', 0, 0, -1, 1, a, 1, t, 1, c, 1, w, info )
 
  169      CALL chkxer( 
'DGEMLQT', infot, nout, lerr, ok )
 
  170      infot = 6
  171      CALL dgemlqt( 
'L', 
'N', 0, 0, 0, 0, a, 1, t, 1, c, 1, w, info )
 
  172      CALL chkxer( 
'DGEMLQT', infot, nout, lerr, ok )
 
  173      infot = 8
  174      CALL dgemlqt( 
'R', 
'N', 2, 2, 2, 1, a, 1, t, 1, c, 1, w, info )
 
  175      CALL chkxer( 
'DGEMLQT', infot, nout, lerr, ok )
 
  176      infot = 8
  177      CALL dgemlqt( 
'L', 
'N', 2, 2, 2, 1, a, 1, t, 1, c, 1, w, info )
 
  178      CALL chkxer( 
'DGEMLQT', infot, nout, lerr, ok )
 
  179      infot = 10
  180      CALL dgemlqt( 
'R', 
'N', 1, 1, 1, 1, a, 1, t, 0, c, 1, w, info )
 
  181      CALL chkxer( 
'DGEMLQT', infot, nout, lerr, ok )
 
  182      infot = 12
  183      CALL dgemlqt( 
'L', 
'N', 1, 1, 1, 1, a, 1, t, 1, c, 0, w, info )
 
  184      CALL chkxer( 
'DGEMLQT', infot, nout, lerr, ok )
 
  185
  186
  187
  188      CALL alaesm( path, ok, nout )
 
  189
  190      RETURN
  191
  192
  193
subroutine alaesm(path, ok, nout)
ALAESM
subroutine chkxer(srnamt, infot, nout, lerr, ok)
recursive subroutine dgelqt3(m, n, a, lda, t, ldt, info)
DGELQT3 recursively computes a LQ factorization of a general real or complex matrix using the compact...
subroutine dgelqt(m, n, mb, a, lda, t, ldt, work, info)
DGELQT
subroutine dgemlqt(side, trans, m, n, k, mb, v, ldv, t, ldt, c, ldc, work, info)
DGEMLQT