55
   56
   57
   58
   59
   60
   61      INTEGER            NUNIT
   62      CHARACTER*3        PATH
   63
   64
   65
   66
   67
   68      INTEGER            NMAX
   69      parameter( nmax = 4 )
   70
   71
   72      INTEGER            I, INFO, J, RANK
   73
   74
   75      REAL               A( NMAX, NMAX ), WORK( 2*NMAX )
   76      INTEGER            PIV( NMAX )
   77
   78
   80
   81
   82      INTEGER            INFOT, NOUT
   83      LOGICAL            LERR, OK
   84      CHARACTER*32       SRNAMT
   85
   86
   87      COMMON             / infoc / infot, nout, ok, lerr
   88      COMMON             / srnamc / srnamt
   89
   90
   91      INTRINSIC          real
   92
   93
   94
   95      nout = nunit
   96      WRITE( nout, fmt = * )
   97
   98
   99
  100      DO 110 j = 1, nmax
  101         DO 100 i = 1, nmax
  102            a( i, j ) = 1.0 / real( i+j )
  103
  104  100    CONTINUE
  105         piv( j ) = j
  106         work( j ) = 0.
  107         work( nmax+j ) = 0.
  108
  109  110 CONTINUE
  110      ok = .true.
  111
  112
  113
  114
  115
  116
  117
  118      srnamt = 'SPSTRF'
  119      infot = 1
  120      CALL spstrf( 
'/', 0, a, 1, piv, rank, -1.0, work, info )
 
  121      CALL chkxer( 
'SPSTRF', infot, nout, lerr, ok )
 
  122      infot = 2
  123      CALL spstrf( 
'U', -1, a, 1, piv, rank, -1.0, work, info )
 
  124      CALL chkxer( 
'SPSTRF', infot, nout, lerr, ok )
 
  125      infot = 4
  126      CALL spstrf( 
'U', 2, a, 1, piv, rank, -1.0, work, info )
 
  127      CALL chkxer( 
'SPSTRF', infot, nout, lerr, ok )
 
  128
  129
  130
  131      srnamt = 'SPSTF2'
  132      infot = 1
  133      CALL spstf2( 
'/', 0, a, 1, piv, rank, -1.0, work, info )
 
  134      CALL chkxer( 
'SPSTF2', infot, nout, lerr, ok )
 
  135      infot = 2
  136      CALL spstf2( 
'U', -1, a, 1, piv, rank, -1.0, work, info )
 
  137      CALL chkxer( 
'SPSTF2', infot, nout, lerr, ok )
 
  138      infot = 4
  139      CALL spstf2( 
'U', 2, a, 1, piv, rank, -1.0, work, info )
 
  140      CALL chkxer( 
'SPSTF2', infot, nout, lerr, ok )
 
  141
  142
  143
  144
  145      CALL alaesm( path, ok, nout )
 
  146
  147      RETURN
  148
  149
  150
subroutine alaesm(path, ok, nout)
ALAESM
subroutine chkxer(srnamt, infot, nout, lerr, ok)
subroutine spstf2(uplo, n, a, lda, piv, rank, tol, work, info)
SPSTF2 computes the Cholesky factorization with complete pivoting of a real symmetric positive semide...
subroutine spstrf(uplo, n, a, lda, piv, rank, tol, work, info)
SPSTRF computes the Cholesky factorization with complete pivoting of a real symmetric positive semide...