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...