1       SUBROUTINE DERRRFP( NUNIT )
  2 *
  3 *  -- LAPACK test routine (version 3.2.0) --
  4 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
  5 *     November 2008
  6 *
  7 *     .. Scalar Arguments ..
  8       INTEGER            NUNIT
  9 *     ..
 10 *
 11 *  Purpose
 12 *  =======
 13 *
 14 *  DERRRFP tests the error exits for the DOUBLE PRECISION driver routines
 15 *  for solving linear systems of equations.
 16 *
 17 *  DDRVRFP tests the DOUBLE PRECISION LAPACK RFP routines:
 18 *      DTFSM, DTFTRI, DSFRK, DTFTTP, DTFTTR, DPFTRF, DPFTRS, DTPTTF,
 19 *      DTPTTR, DTRTTF, and DTRTTP
 20 *
 21 *  Arguments
 22 *  =========
 23 *
 24 *  NUNIT   (input) INTEGER
 25 *          The unit number for output.
 26 *
 27 *  =====================================================================
 28 *
 29 *     ..
 30 *     .. Local Scalars ..
 31       INTEGER            INFO
 32       DOUBLE PRECISION   ALPHA, BETA
 33 *     ..
 34 *     .. Local Arrays ..
 35       DOUBLE PRECISION   A( 11), B( 11)
 36 *     ..
 37 *     .. External Subroutines ..
 38       EXTERNAL           CHKXER, DTFSM, DTFTRI, DSFRK, DTFTTP, DTFTTR,
 39      +                   DPFTRI, DPFTRF, DPFTRS, DTPTTF, DTPTTR, DTRTTF,
 40      +                   DTRTTP
 41 *     ..
 42 *     .. Scalars in Common ..
 43       LOGICAL            LERR, OK
 44       CHARACTER*32       SRNAMT
 45       INTEGER            INFOT, NOUT
 46 *     ..
 47 *     .. Common blocks ..
 48       COMMON             / INFOC / INFOT, NOUT, OK, LERR
 49       COMMON             / SRNAMC / SRNAMT
 50 *     ..
 51 *     .. Executable Statements ..
 52 *
 53       NOUT = NUNIT
 54       OK = .TRUE.
 55       A( 11 ) = 1.0D+0
 56       B( 11 ) = 1.0D+0
 57       ALPHA     = 1.0D+0
 58       BETA      = 1.0D+0
 59 *
 60       SRNAMT = 'DPFTRF'
 61       INFOT = 1
 62       CALL DPFTRF( '/''U'0, A, INFO )
 63       CALL CHKXER( 'DPFTRF', INFOT, NOUT, LERR, OK )
 64       INFOT = 2
 65       CALL DPFTRF( 'N''/'0, A, INFO )
 66       CALL CHKXER( 'DPFTRF', INFOT, NOUT, LERR, OK )
 67       INFOT = 3
 68       CALL DPFTRF( 'N''U'-1, A, INFO )
 69       CALL CHKXER( 'DPFTRF', INFOT, NOUT, LERR, OK )
 70 *
 71       SRNAMT = 'DPFTRS'
 72       INFOT = 1
 73       CALL DPFTRS( '/''U'00, A, B, 1, INFO )
 74       CALL CHKXER( 'DPFTRS', INFOT, NOUT, LERR, OK )
 75       INFOT = 2
 76       CALL DPFTRS( 'N''/'00, A, B, 1, INFO )
 77       CALL CHKXER( 'DPFTRS', INFOT, NOUT, LERR, OK )
 78       INFOT = 3
 79       CALL DPFTRS( 'N''U'-10, A, B, 1, INFO )
 80       CALL CHKXER( 'DPFTRS', INFOT, NOUT, LERR, OK )
 81       INFOT = 4
 82       CALL DPFTRS( 'N''U'0-1, A, B, 1, INFO )
 83       CALL CHKXER( 'DPFTRS', INFOT, NOUT, LERR, OK )
 84       INFOT = 7
 85       CALL DPFTRS( 'N''U'00, A, B, 0, INFO )
 86       CALL CHKXER( 'DPFTRS', INFOT, NOUT, LERR, OK )
 87 *
 88       SRNAMT = 'DPFTRI'
 89       INFOT = 1
 90       CALL DPFTRI( '/''U'0, A, INFO )
 91       CALL CHKXER( 'DPFTRI', INFOT, NOUT, LERR, OK )
 92       INFOT = 2
 93       CALL DPFTRI( 'N''/'0, A, INFO )
 94       CALL CHKXER( 'DPFTRI', INFOT, NOUT, LERR, OK )
 95       INFOT = 3
 96       CALL DPFTRI( 'N''U'-1, A, INFO )
 97       CALL CHKXER( 'DPFTRI', INFOT, NOUT, LERR, OK )
 98 *
 99       SRNAMT = 'DTFSM '
100       INFOT = 1
101       CALL DTFSM( '/''L''U''T''U'00, ALPHA, A, B, 1 )
102       CALL CHKXER( 'DTFSM ', INFOT, NOUT, LERR, OK )
103       INFOT = 2
104       CALL DTFSM( 'N''/''U''T''U'00, ALPHA, A, B, 1 )
105       CALL CHKXER( 'DTFSM ', INFOT, NOUT, LERR, OK )
106       INFOT = 3
107       CALL DTFSM( 'N''L''/''T''U'00, ALPHA, A, B, 1 )
108       CALL CHKXER( 'DTFSM ', INFOT, NOUT, LERR, OK )
109       INFOT = 4
110       CALL DTFSM( 'N''L''U''/''U'00, ALPHA, A, B, 1 )
111       CALL CHKXER( 'DTFSM ', INFOT, NOUT, LERR, OK )
112       INFOT = 5
113       CALL DTFSM( 'N''L''U''T''/'00, ALPHA, A, B, 1 )
114       CALL CHKXER( 'DTFSM ', INFOT, NOUT, LERR, OK )
115       INFOT = 6
116       CALL DTFSM( 'N''L''U''T''U'-10, ALPHA, A, B, 1 )
117       CALL CHKXER( 'DTFSM ', INFOT, NOUT, LERR, OK )
118       INFOT = 7
119       CALL DTFSM( 'N''L''U''T''U'0-1, ALPHA, A, B, 1 )
120       CALL CHKXER( 'DTFSM ', INFOT, NOUT, LERR, OK )
121       INFOT = 11
122       CALL DTFSM( 'N''L''U''T''U'00, ALPHA, A, B, 0 )
123       CALL CHKXER( 'DTFSM ', INFOT, NOUT, LERR, OK )
124 *
125       SRNAMT = 'DTFTRI'
126       INFOT = 1
127       CALL DTFTRI( '/''L''N'0, A, INFO )
128       CALL CHKXER( 'DTFTRI', INFOT, NOUT, LERR, OK )
129       INFOT = 2
130       CALL DTFTRI( 'N''/''N'0, A, INFO )
131       CALL CHKXER( 'DTFTRI', INFOT, NOUT, LERR, OK )
132       INFOT = 3
133       CALL DTFTRI( 'N''L''/'0, A, INFO )
134       CALL CHKXER( 'DTFTRI', INFOT, NOUT, LERR, OK )
135       INFOT = 4
136       CALL DTFTRI( 'N''L''N'-1, A, INFO )
137       CALL CHKXER( 'DTFTRI', INFOT, NOUT, LERR, OK )
138 *
139       SRNAMT = 'DTFTTR'
140       INFOT = 1
141       CALL DTFTTR( '/''U'0, A, B, 1, INFO )
142       CALL CHKXER( 'DTFTTR', INFOT, NOUT, LERR, OK )
143       INFOT = 2
144       CALL DTFTTR( 'N''/'0, A, B, 1, INFO )
145       CALL CHKXER( 'DTFTTR', INFOT, NOUT, LERR, OK )
146       INFOT = 3
147       CALL DTFTTR( 'N''U'-1, A, B, 1, INFO )
148       CALL CHKXER( 'DTFTTR', INFOT, NOUT, LERR, OK )
149       INFOT = 6
150       CALL DTFTTR( 'N''U'0, A, B, 0, INFO )
151       CALL CHKXER( 'DTFTTR', INFOT, NOUT, LERR, OK )
152 *
153       SRNAMT = 'DTRTTF'
154       INFOT = 1
155       CALL DTRTTF( '/''U'0, A, 1, B, INFO )
156       CALL CHKXER( 'DTRTTF', INFOT, NOUT, LERR, OK )
157       INFOT = 2
158       CALL DTRTTF( 'N''/'0, A, 1, B, INFO )
159       CALL CHKXER( 'DTRTTF', INFOT, NOUT, LERR, OK )
160       INFOT = 3
161       CALL DTRTTF( 'N''U'-1, A, 1, B, INFO )
162       CALL CHKXER( 'DTRTTF', INFOT, NOUT, LERR, OK )
163       INFOT = 5
164       CALL DTRTTF( 'N''U'0, A, 0, B, INFO )
165       CALL CHKXER( 'DTRTTF', INFOT, NOUT, LERR, OK )
166 *
167       SRNAMT = 'DTFTTP'
168       INFOT = 1
169       CALL DTFTTP( '/''U'0, A, B, INFO )
170       CALL CHKXER( 'DTFTTP', INFOT, NOUT, LERR, OK )
171       INFOT = 2
172       CALL DTFTTP( 'N''/'0, A, B, INFO )
173       CALL CHKXER( 'DTFTTP', INFOT, NOUT, LERR, OK )
174       INFOT = 3
175       CALL DTFTTP( 'N''U'-1, A, B, INFO )
176       CALL CHKXER( 'DTFTTP', INFOT, NOUT, LERR, OK )
177 *
178       SRNAMT = 'DTPTTF'
179       INFOT = 1
180       CALL DTPTTF( '/''U'0, A, B, INFO )
181       CALL CHKXER( 'DTPTTF', INFOT, NOUT, LERR, OK )
182       INFOT = 2
183       CALL DTPTTF( 'N''/'0, A, B, INFO )
184       CALL CHKXER( 'DTPTTF', INFOT, NOUT, LERR, OK )
185       INFOT = 3
186       CALL DTPTTF( 'N''U'-1, A, B, INFO )
187       CALL CHKXER( 'DTPTTF', INFOT, NOUT, LERR, OK )
188 *
189       SRNAMT = 'DTRTTP'
190       INFOT = 1
191       CALL DTRTTP( '/'0, A, 1,  B, INFO )
192       CALL CHKXER( 'DTRTTP', INFOT, NOUT, LERR, OK )
193       INFOT = 2
194       CALL DTRTTP( 'U'-1, A, 1,  B, INFO )
195       CALL CHKXER( 'DTRTTP', INFOT, NOUT, LERR, OK )
196       INFOT = 4
197       CALL DTRTTP( 'U'0, A, 0,  B, INFO )
198       CALL CHKXER( 'DTRTTP', INFOT, NOUT, LERR, OK )
199 *
200       SRNAMT = 'DTPTTR'
201       INFOT = 1
202       CALL DTPTTR( '/'0, A, B, 1,  INFO )
203       CALL CHKXER( 'DTPTTR', INFOT, NOUT, LERR, OK )
204       INFOT = 2
205       CALL DTPTTR( 'U'-1, A, B, 1,  INFO )
206       CALL CHKXER( 'DTPTTR', INFOT, NOUT, LERR, OK )
207       INFOT = 5
208       CALL DTPTTR( 'U'0, A, B, 0, INFO )
209       CALL CHKXER( 'DTPTTR', INFOT, NOUT, LERR, OK )
210 *
211       SRNAMT = 'DSFRK '
212       INFOT = 1
213       CALL DSFRK( '/''U''N'00, ALPHA, A, 1, BETA, B )
214       CALL CHKXER( 'DSFRK ', INFOT, NOUT, LERR, OK )
215       INFOT = 2
216       CALL DSFRK( 'N''/''N'00, ALPHA, A, 1, BETA, B )
217       CALL CHKXER( 'DSFRK ', INFOT, NOUT, LERR, OK )
218       INFOT = 3
219       CALL DSFRK( 'N''U''/'00, ALPHA, A, 1, BETA, B )
220       CALL CHKXER( 'DSFRK ', INFOT, NOUT, LERR, OK )
221       INFOT = 4
222       CALL DSFRK( 'N''U''N'-10, ALPHA, A, 1, BETA, B )
223       CALL CHKXER( 'DSFRK ', INFOT, NOUT, LERR, OK )
224       INFOT = 5
225       CALL DSFRK( 'N''U''N'0-1, ALPHA, A, 1, BETA, B )
226       CALL CHKXER( 'DSFRK ', INFOT, NOUT, LERR, OK )
227       INFOT = 8
228       CALL DSFRK( 'N''U''N'00, ALPHA, A, 0, BETA, B )
229       CALL CHKXER( 'DSFRK ', INFOT, NOUT, LERR, OK )
230 *
231 *     Print a summary line.
232 *
233       IF( OK ) THEN
234          WRITE( NOUT, FMT = 9999 )
235       ELSE
236          WRITE( NOUT, FMT = 9998 )
237       END IF
238 *
239  9999 FORMAT1X'DOUBLE PRECISION RFP routines passed the tests of ',
240      $        'the error exits' )
241  9998 FORMAT' *** RFP routines failed the tests of the error ',
242      $        'exits ***' )
243       RETURN
244 *
245 *     End of DERRRFP
246 *
247       END