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 A( NMAX, NMAX )
76 REAL 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 real
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.0 / real( i+j )
104
105 100 CONTINUE
106 piv( j ) = j
107 rwork( j ) = 0.
108 rwork( nmax+j ) = 0.
109
110 110 CONTINUE
111 ok = .true.
112
113
114
115
116
117
118
119 srnamt = 'CPSTRF'
120 infot = 1
121 CALL cpstrf(
'/', 0, a, 1, piv, rank, -1.0, rwork, info )
122 CALL chkxer(
'CPSTRF', infot, nout, lerr, ok )
123 infot = 2
124 CALL cpstrf(
'U', -1, a, 1, piv, rank, -1.0, rwork, info )
125 CALL chkxer(
'CPSTRF', infot, nout, lerr, ok )
126 infot = 4
127 CALL cpstrf(
'U', 2, a, 1, piv, rank, -1.0, rwork, info )
128 CALL chkxer(
'CPSTRF', infot, nout, lerr, ok )
129
130
131
132 srnamt = 'CPSTF2'
133 infot = 1
134 CALL cpstf2(
'/', 0, a, 1, piv, rank, -1.0, rwork, info )
135 CALL chkxer(
'CPSTF2', infot, nout, lerr, ok )
136 infot = 2
137 CALL cpstf2(
'U', -1, a, 1, piv, rank, -1.0, rwork, info )
138 CALL chkxer(
'CPSTF2', infot, nout, lerr, ok )
139 infot = 4
140 CALL cpstf2(
'U', 2, a, 1, piv, rank, -1.0, rwork, info )
141 CALL chkxer(
'CPSTF2', 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 cpstf2(uplo, n, a, lda, piv, rank, tol, work, info)
CPSTF2 computes the Cholesky factorization with complete pivoting of complex Hermitian positive semid...
subroutine cpstrf(uplo, n, a, lda, piv, rank, tol, work, info)
CPSTRF computes the Cholesky factorization with complete pivoting of complex Hermitian positive semid...