1*> \brief \b ZCHKRFP
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*  Definition:
9*  ===========
10*
11*       PROGRAM ZCHKRFP
12*
13*
14*> \par Purpose:
15*  =============
16*>
17*> \verbatim
18*>
19*> ZCHKRFP is the main test program for the COMPLEX*16 linear equation
20*> routines with RFP storage format
21*>
22*> \endverbatim
23*
24*  Arguments:
25*  ==========
26*
27*> \verbatim
28*>  MAXIN   INTEGER
29*>          The number of different values that can be used for each of
30*>          M, N, or NB
31*>
32*>  MAXRHS  INTEGER
33*>          The maximum number of right hand sides
34*>
35*>  NTYPES  INTEGER
36*>
37*>  NMAX    INTEGER
38*>          The maximum allowable value for N.
39*>
40*>  NIN     INTEGER
41*>          The unit number for input
42*>
43*>  NOUT    INTEGER
44*>          The unit number for output
45*> \endverbatim
46*
47*  Authors:
48*  ========
49*
50*> \author Univ. of Tennessee
51*> \author Univ. of California Berkeley
52*> \author Univ. of Colorado Denver
53*> \author NAG Ltd.
54*
55*> \date April 2012
56*
57*> \ingroup complex16_lin
58*
59*  =====================================================================
60      PROGRAM ZCHKRFP
61*
62*  -- LAPACK test routine (version 3.4.1) --
63*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
64*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
65*     April 2012
66*
67*  =====================================================================
68*
69*     .. Parameters ..
70      INTEGER            MAXIN
71      PARAMETER          ( MAXIN = 12 )
72      INTEGER            NMAX
73      PARAMETER          ( NMAX =  50 )
74      INTEGER            MAXRHS
75      PARAMETER          ( MAXRHS = 16 )
76      INTEGER            NTYPES
77      PARAMETER          ( NTYPES = 9 )
78      INTEGER            NIN, NOUT
79      PARAMETER          ( NIN = 5, NOUT = 6 )
80*     ..
81*     .. Local Scalars ..
82      LOGICAL            FATAL, TSTERR
83      INTEGER            VERS_MAJOR, VERS_MINOR, VERS_PATCH
84      INTEGER            I, NN, NNS, NNT
85      DOUBLE PRECISION   EPS, S1, S2, THRESH
86
87*     ..
88*     .. Local Arrays ..
89      INTEGER            NVAL( MAXIN ), NSVAL( MAXIN ), NTVAL( NTYPES )
90      COMPLEX*16         WORKA( NMAX, NMAX )
91      COMPLEX*16         WORKASAV( NMAX, NMAX )
92      COMPLEX*16         WORKB( NMAX, MAXRHS )
93      COMPLEX*16         WORKXACT( NMAX, MAXRHS )
94      COMPLEX*16         WORKBSAV( NMAX, MAXRHS )
95      COMPLEX*16         WORKX( NMAX, MAXRHS )
96      COMPLEX*16         WORKAFAC( NMAX, NMAX )
97      COMPLEX*16         WORKAINV( NMAX, NMAX )
98      COMPLEX*16         WORKARF( (NMAX*(NMAX+1))/2 )
99      COMPLEX*16         WORKAP( (NMAX*(NMAX+1))/2 )
100      COMPLEX*16         WORKARFINV( (NMAX*(NMAX+1))/2 )
101      COMPLEX*16         Z_WORK_ZLATMS( 3 * NMAX )
102      COMPLEX*16         Z_WORK_ZPOT02( NMAX, MAXRHS )
103      COMPLEX*16         Z_WORK_ZPOT03( NMAX, NMAX )
104      DOUBLE PRECISION   D_WORK_ZLATMS( NMAX )
105      DOUBLE PRECISION   D_WORK_ZLANHE( NMAX )
106      DOUBLE PRECISION   D_WORK_ZPOT01( NMAX )
107      DOUBLE PRECISION   D_WORK_ZPOT02( NMAX )
108      DOUBLE PRECISION   D_WORK_ZPOT03( NMAX )
109*     ..
110*     .. External Functions ..
111      DOUBLE PRECISION   DLAMCH, DSECND
112      EXTERNAL           DLAMCH, DSECND
113*     ..
114*     .. External Subroutines ..
115      EXTERNAL           ILAVER, ZDRVRFP, ZDRVRF1, ZDRVRF2, ZDRVRF3,
116     +                   ZDRVRF4
117*     ..
118*     .. Executable Statements ..
119*
120#ifdef __FLAME__
121      CALL FLA_INIT
122#endif
123      S1 = DSECND( )
124      FATAL = .FALSE.
125*
126*     Read a dummy line.
127*
128      READ( NIN, FMT = * )
129*
130*     Report LAPACK version tag (e.g. LAPACK-3.2.0)
131*
132      CALL ILAVER( VERS_MAJOR, VERS_MINOR, VERS_PATCH )
133      WRITE( NOUT, FMT = 9994 ) VERS_MAJOR, VERS_MINOR, VERS_PATCH
134*
135*     Read the values of N
136*
137      READ( NIN, FMT = * )NN
138      IF( NN.LT.1 ) THEN
139         WRITE( NOUT, FMT = 9996 )' NN ', NN, 1
140         NN = 0
141         FATAL = .TRUE.
142      ELSE IF( NN.GT.MAXIN ) THEN
143         WRITE( NOUT, FMT = 9995 )' NN ', NN, MAXIN
144         NN = 0
145         FATAL = .TRUE.
146      END IF
147      READ( NIN, FMT = * )( NVAL( I ), I = 1, NN )
148      DO 10 I = 1, NN
149         IF( NVAL( I ).LT.0 ) THEN
150            WRITE( NOUT, FMT = 9996 )' M  ', NVAL( I ), 0
151            FATAL = .TRUE.
152         ELSE IF( NVAL( I ).GT.NMAX ) THEN
153            WRITE( NOUT, FMT = 9995 )' M  ', NVAL( I ), NMAX
154            FATAL = .TRUE.
155         END IF
156   10 CONTINUE
157      IF( NN.GT.0 )
158     $   WRITE( NOUT, FMT = 9993 )'N   ', ( NVAL( I ), I = 1, NN )
159*
160*     Read the values of NRHS
161*
162      READ( NIN, FMT = * )NNS
163      IF( NNS.LT.1 ) THEN
164         WRITE( NOUT, FMT = 9996 )' NNS', NNS, 1
165         NNS = 0
166         FATAL = .TRUE.
167      ELSE IF( NNS.GT.MAXIN ) THEN
168         WRITE( NOUT, FMT = 9995 )' NNS', NNS, MAXIN
169         NNS = 0
170         FATAL = .TRUE.
171      END IF
172      READ( NIN, FMT = * )( NSVAL( I ), I = 1, NNS )
173      DO 30 I = 1, NNS
174         IF( NSVAL( I ).LT.0 ) THEN
175            WRITE( NOUT, FMT = 9996 )'NRHS', NSVAL( I ), 0
176            FATAL = .TRUE.
177         ELSE IF( NSVAL( I ).GT.MAXRHS ) THEN
178            WRITE( NOUT, FMT = 9995 )'NRHS', NSVAL( I ), MAXRHS
179            FATAL = .TRUE.
180         END IF
181   30 CONTINUE
182      IF( NNS.GT.0 )
183     $   WRITE( NOUT, FMT = 9993 )'NRHS', ( NSVAL( I ), I = 1, NNS )
184*
185*     Read the matrix types
186*
187      READ( NIN, FMT = * )NNT
188      IF( NNT.LT.1 ) THEN
189         WRITE( NOUT, FMT = 9996 )' NMA', NNT, 1
190         NNT = 0
191         FATAL = .TRUE.
192      ELSE IF( NNT.GT.NTYPES ) THEN
193         WRITE( NOUT, FMT = 9995 )' NMA', NNT, NTYPES
194         NNT = 0
195         FATAL = .TRUE.
196      END IF
197      READ( NIN, FMT = * )( NTVAL( I ), I = 1, NNT )
198      DO 320 I = 1, NNT
199         IF( NTVAL( I ).LT.0 ) THEN
200            WRITE( NOUT, FMT = 9996 )'TYPE', NTVAL( I ), 0
201            FATAL = .TRUE.
202         ELSE IF( NTVAL( I ).GT.NTYPES ) THEN
203            WRITE( NOUT, FMT = 9995 )'TYPE', NTVAL( I ), NTYPES
204            FATAL = .TRUE.
205         END IF
206  320 CONTINUE
207      IF( NNT.GT.0 )
208     $   WRITE( NOUT, FMT = 9993 )'TYPE', ( NTVAL( I ), I = 1, NNT )
209*
210*     Read the threshold value for the test ratios.
211*
212      READ( NIN, FMT = * )THRESH
213      WRITE( NOUT, FMT = 9992 )THRESH
214*
215*     Read the flag that indicates whether to test the error exits.
216*
217      READ( NIN, FMT = * )TSTERR
218*
219      IF( FATAL ) THEN
220         WRITE( NOUT, FMT = 9999 )
221         STOP
222      END IF
223*
224      IF( FATAL ) THEN
225         WRITE( NOUT, FMT = 9999 )
226         STOP
227      END IF
228*
229*     Calculate and print the machine dependent constants.
230*
231      EPS = DLAMCH( 'Underflow threshold' )
232      WRITE( NOUT, FMT = 9991 )'underflow', EPS
233      EPS = DLAMCH( 'Overflow threshold' )
234      WRITE( NOUT, FMT = 9991 )'overflow ', EPS
235      EPS = DLAMCH( 'Epsilon' )
236      WRITE( NOUT, FMT = 9991 )'precision', EPS
237      WRITE( NOUT, FMT = * )
238*
239*     Test the error exit of:
240*
241      IF( TSTERR )
242     $   CALL ZERRRFP( NOUT )
243*
244*    Test the routines: zpftrf, zpftri, zpftrs (as in ZDRVPO).
245*    This also tests the routines: ztfsm, ztftri, ztfttr, ztrttf.
246*
247      CALL ZDRVRFP( NOUT, NN, NVAL, NNS, NSVAL, NNT, NTVAL, THRESH,
248     $              WORKA, WORKASAV, WORKAFAC, WORKAINV, WORKB,
249     $              WORKBSAV, WORKXACT, WORKX, WORKARF, WORKARFINV,
250     $              Z_WORK_ZLATMS, Z_WORK_ZPOT02,
251     $              Z_WORK_ZPOT03, D_WORK_ZLATMS, D_WORK_ZLANHE,
252     $              D_WORK_ZPOT01, D_WORK_ZPOT02, D_WORK_ZPOT03 )
253*
254*    Test the routine: zlanhf
255*
256      CALL ZDRVRF1( NOUT, NN, NVAL, THRESH, WORKA, NMAX, WORKARF,
257     +              D_WORK_ZLANHE )
258*
259*    Test the convertion routines:
260*       zhfttp, ztpthf, ztfttr, ztrttf, ztrttp and ztpttr.
261*
262      CALL ZDRVRF2( NOUT, NN, NVAL, WORKA, NMAX, WORKARF,
263     +              WORKAP, WORKASAV )
264*
265*    Test the routine: ztfsm
266*
267      CALL ZDRVRF3( NOUT, NN, NVAL, THRESH, WORKA, NMAX, WORKARF,
268     +              WORKAINV, WORKAFAC, D_WORK_ZLANHE,
269     +              Z_WORK_ZPOT03, Z_WORK_ZPOT02 )
270
271*
272*    Test the routine: zhfrk
273*
274      CALL ZDRVRF4( NOUT, NN, NVAL, THRESH, WORKA, WORKAFAC, NMAX,
275     +              WORKARF, WORKAINV, NMAX,D_WORK_ZLANHE)
276*
277      CLOSE ( NIN )
278      S2 = DSECND( )
279      WRITE( NOUT, FMT = 9998 )
280      WRITE( NOUT, FMT = 9997 )S2 - S1
281*
282 9999 FORMAT( / ' Execution not attempted due to input errors' )
283 9998 FORMAT( / ' End of tests' )
284 9997 FORMAT( ' Total time used = ', F12.2, ' seconds', / )
285 9996 FORMAT( ' !! Invalid input value: ', A4, '=', I6, '; must be >=',
286     $      I6 )
287 9995 FORMAT( ' !! Invalid input value: ', A4, '=', I6, '; must be <=',
288     $      I6 )
289 9994 FORMAT( /  ' Tests of the COMPLEX*16 LAPACK RFP routines ',
290     $      / ' LAPACK VERSION ', I1, '.', I1, '.', I1,
291     $      / / ' The following parameter values will be used:' )
292 9993 FORMAT( 4X, A4, ':  ', 10I6, / 11X, 10I6 )
293 9992 FORMAT( / ' Routines pass computational tests if test ratio is ',
294     $      'less than', F8.2, / )
295 9991 FORMAT( ' Relative machine ', A, ' is taken to be', D16.6 )
296*
297#ifdef __FLAME__
298      CALL FLA_FINALIZE
299#endif
300*
301*     End of ZCHKRFP
302*
303      END
304