cdrvrf2()

subroutine cdrvrf2	(	integer	NOUT,
		integer	NN,
		integer, dimension( nn )	NVAL,
		complex, dimension( lda, * )	A,
		integer	LDA,
		complex, dimension( * )	ARF,
		complex, dimension(*)	AP,
		complex, dimension( lda, * )	ASAV
	)

CDRVRF2

Purpose:

 CDRVRF2 tests the LAPACK RFP conversion routines.

Parameters

[in]	NOUT	NOUT is INTEGER The unit number for output.
[in]	NN	NN is INTEGER The number of values of N contained in the vector NVAL.
[in]	NVAL	NVAL is INTEGER array, dimension (NN) The values of the matrix dimension N.
[out]	A	A is COMPLEX array, dimension (LDA,NMAX)
[in]	LDA	LDA is INTEGER The leading dimension of the array A. LDA >= max(1,NMAX).
[out]	ARF	ARF is COMPLEX array, dimension ((NMAX*(NMAX+1))/2).
[out]	AP	AP is COMPLEX array, dimension ((NMAX*(NMAX+1))/2).
[out]	ASAV	ASAV is COMPLEX6 array, dimension (LDA,NMAX)

Author

Univ. of Tennessee

Univ. of California Berkeley

Univ. of Colorado Denver

NAG Ltd.

Date

December 2016

Definition at line 91 of file cdrvrf2.f.

*
*  -- LAPACK test routine (version 3.7.0) --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*     December 2016
*
*     .. Scalar Arguments ..
      INTEGER            LDA, NN, NOUT
*     ..
*     .. Array Arguments ..
      INTEGER            NVAL( NN )
      COMPLEX            A( LDA, * ), ARF( * ), AP(*), ASAV( LDA, * )
*     ..
*
*  =====================================================================
*     ..
*     .. Local Scalars ..
      LOGICAL            LOWER, OK1, OK2
      CHARACTER          UPLO, CFORM
      INTEGER            I, IFORM, IIN, INFO, IUPLO, J, N,
     +                   NERRS, NRUN
*     ..
*     .. Local Arrays ..
      CHARACTER          UPLOS( 2 ), FORMS( 2 )
      INTEGER            ISEED( 4 ), ISEEDY( 4 )
*     ..
*     .. External Functions ..
      COMPLEX            CLARND
      EXTERNAL           clarnd
*     ..
*     .. External Subroutines ..
      EXTERNAL           ctfttr, ctfttp, ctrttf, ctrttp, ctpttr, ctpttf
*     ..
*     .. Scalars in Common ..
      CHARACTER*32       SRNAMT
*     ..
*     .. Common blocks ..
      COMMON             / srnamc / srnamt
*     ..
*     .. Data statements ..
      DATA               iseedy / 1988, 1989, 1990, 1991 /
      DATA               uplos / 'U', 'L' /
      DATA               forms / 'N', 'C' /
*     ..
*     .. Executable Statements ..
*
*     Initialize constants and the random number seed.
*
      nrun = 0
      nerrs = 0
      info = 0
      DO 10 i = 1, 4
         iseed( i ) = iseedy( i )
   10 CONTINUE
*
      DO 120 iin = 1, nn
*
         n = nval( iin )
*
*        Do first for UPLO = 'U', then for UPLO = 'L'
*
         DO 110 iuplo = 1, 2
*
            uplo = uplos( iuplo )
            lower = .true.
            IF ( iuplo.EQ.1 ) lower = .false.
*
*           Do first for CFORM = 'N', then for CFORM = 'C'
*
            DO 100 iform = 1, 2
*
               cform = forms( iform )
*
               nrun = nrun + 1
*
               DO j = 1, n
                  DO i = 1, n
                     a( i, j) = clarnd( 4, iseed )
                  END DO
               END DO
*
               srnamt = 'CTRTTF'
               CALL ctrttf( cform, uplo, n, a, lda, arf, info )
*
               srnamt = 'CTFTTP'
               CALL ctfttp( cform, uplo, n, arf, ap, info )
*
               srnamt = 'CTPTTR'
               CALL ctpttr( uplo, n, ap, asav, lda, info )
*
               ok1 = .true.
               IF ( lower ) THEN
                  DO j = 1, n
                     DO i = j, n
                        IF ( a(i,j).NE.asav(i,j) ) THEN
                           ok1 = .false.
                        END IF
                     END DO
                  END DO
               ELSE
                  DO j = 1, n
                     DO i = 1, j
                        IF ( a(i,j).NE.asav(i,j) ) THEN
                           ok1 = .false.
                        END IF
                     END DO
                  END DO
               END IF
*
               nrun = nrun + 1
*
               srnamt = 'CTRTTP'
               CALL ctrttp( uplo, n, a, lda, ap, info )
*
               srnamt = 'CTPTTF'
               CALL ctpttf( cform, uplo, n, ap, arf, info )
*
               srnamt = 'CTFTTR'
               CALL ctfttr( cform, uplo, n, arf, asav, lda, info )
*
               ok2 = .true.
               IF ( lower ) THEN
                  DO j = 1, n
                     DO i = j, n
                        IF ( a(i,j).NE.asav(i,j) ) THEN
                           ok2 = .false.
                        END IF
                     END DO
                  END DO
               ELSE
                  DO j = 1, n
                     DO i = 1, j
                        IF ( a(i,j).NE.asav(i,j) ) THEN
                           ok2 = .false.
                        END IF
                     END DO
                  END DO
               END IF
*
               IF (( .NOT.ok1 ).OR.( .NOT.ok2 )) THEN
                  IF( nerrs.EQ.0 ) THEN
                     WRITE( nout, * )
                     WRITE( nout, fmt = 9999 )
                  END IF
                  WRITE( nout, fmt = 9998 ) n, uplo, cform
                  nerrs = nerrs + 1
               END IF
*
  100       CONTINUE
  110    CONTINUE
  120 CONTINUE
*
*     Print a summary of the results.
*
      IF ( nerrs.EQ.0 ) THEN
         WRITE( nout, fmt = 9997 ) nrun
      ELSE
         WRITE( nout, fmt = 9996 ) nerrs, nrun
      END IF
*
 9999 FORMAT( 1x, ' *** Error(s) while testing the RFP conversion',
     +         ' routines ***')
 9998 FORMAT( 1x, '     Error in RFP,conversion routines N=',i5,
     +        ' UPLO=''', a1, ''', FORM =''',a1,'''')
 9997 FORMAT( 1x, 'All tests for the RFP conversion routines passed ( ',
     +        i5,' tests run)')
 9996 FORMAT( 1x, 'RFP conversion routines: ',i5,' out of ',i5,
     +        ' error message recorded')
*
      RETURN
*
*     End of CDRVRF2
*

Here is the call graph for this function:

Here is the caller graph for this function: