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 COMPLEX*16 A( NMAX, NMAX )
76 DOUBLE PRECISION RWORK( 2*NMAX )
77 INTEGER PIV( NMAX )
78
79
81
82
83 INTEGER INFOT, NOUT
84 LOGICAL LERR, OK
85 CHARACTER*32 SRNAMT
86
87
88 COMMON / infoc / infot, nout, ok, lerr
89 COMMON / srnamc / srnamt
90
91
92 INTRINSIC dble
93
94
95
96 nout = nunit
97 WRITE( nout, fmt = * )
98
99
100
101 DO 110 j = 1, nmax
102 DO 100 i = 1, nmax
103 a( i, j ) = 1.d0 / dble( i+j )
104
105 100 CONTINUE
106 piv( j ) = j
107 rwork( j ) = 0.d0
108 rwork( nmax+j ) = 0.d0
109
110 110 CONTINUE
111 ok = .true.
112
113
114
115
116
117
118
119 srnamt = 'ZPSTRF'
120 infot = 1
121 CALL zpstrf(
'/', 0, a, 1, piv, rank, -1.d0, rwork, info )
122 CALL chkxer(
'ZPSTRF', infot, nout, lerr, ok )
123 infot = 2
124 CALL zpstrf(
'U', -1, a, 1, piv, rank, -1.d0, rwork, info )
125 CALL chkxer(
'ZPSTRF', infot, nout, lerr, ok )
126 infot = 4
127 CALL zpstrf(
'U', 2, a, 1, piv, rank, -1.d0, rwork, info )
128 CALL chkxer(
'ZPSTRF', infot, nout, lerr, ok )
129
130
131
132 srnamt = 'ZPSTF2'
133 infot = 1
134 CALL zpstf2(
'/', 0, a, 1, piv, rank, -1.d0, rwork, info )
135 CALL chkxer(
'ZPSTF2', infot, nout, lerr, ok )
136 infot = 2
137 CALL zpstf2(
'U', -1, a, 1, piv, rank, -1.d0, rwork, info )
138 CALL chkxer(
'ZPSTF2', infot, nout, lerr, ok )
139 infot = 4
140 CALL zpstf2(
'U', 2, a, 1, piv, rank, -1.d0, rwork, info )
141 CALL chkxer(
'ZPSTF2', infot, nout, lerr, ok )
142
143
144
145
146 CALL alaesm( path, ok, nout )
147
148 RETURN
149
150
151
subroutine alaesm(path, ok, nout)
ALAESM
subroutine chkxer(srnamt, infot, nout, lerr, ok)
subroutine zpstf2(uplo, n, a, lda, piv, rank, tol, work, info)
ZPSTF2 computes the Cholesky factorization with complete pivoting of a complex Hermitian positive sem...
subroutine zpstrf(uplo, n, a, lda, piv, rank, tol, work, info)
ZPSTRF computes the Cholesky factorization with complete pivoting of a complex Hermitian positive sem...