Functions
subroutine	alahdg (iounit, path)
	ALAHDG
subroutine	alareq (path, nmats, dotype, ntypes, nin, nout)
	ALAREQ
subroutine	alarqg (path, nmats, dotype, ntypes, nin, nout)
	ALARQG
subroutine	alasmg (type, nout, nfail, nrun, nerrs)
	ALASMG
subroutine	alasum (type, nout, nfail, nrun, nerrs)
	ALASUM
subroutine	alasvm (type, nout, nfail, nrun, nerrs)
	ALASVM
subroutine	xerbla (srname, info)
	XERBLA
subroutine	xlaenv (ispec, nvalue)
	XLAENV

Detailed Description

This is the group of auxiliary LAPACK TESTING EIG routines.

Function Documentation

◆ alahdg()

subroutine alahdg	(	integer	iounit,
		character*3	path )

ALAHDG

Purpose:

!>
!> ALAHDG prints header information for the different test paths.
!>

Parameters

[in]

IOUNIT

!>          IOUNIT is INTEGER
!>          The unit number to which the header information should be
!>          printed.
!>

[in]

PATH

!>          PATH is CHARACTER*3
!>          The name of the path for which the header information is to
!>          be printed.  Current paths are
!>             GQR:  GQR (general matrices)
!>             GRQ:  GRQ (general matrices)
!>             LSE:  LSE Problem
!>             GLM:  GLM Problem
!>             GSV:  Generalized Singular Value Decomposition
!>             CSD:  CS Decomposition
!>

Author: Univ. of Tennessee; Univ. of California Berkeley; Univ. of Colorado Denver; NAG Ltd.

Definition at line 61 of file alahdg.f.

*
*  -- LAPACK test routine --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
*     .. Scalar Arguments ..
      CHARACTER*3       PATH
      INTEGER           IOUNIT
*     ..
*
*  =====================================================================
*
*     .. Local Scalars ..
      CHARACTER*3       C2
      INTEGER           ITYPE
*     ..
*     .. External Functions ..
      LOGICAL           LSAMEN
      EXTERNAL          lsamen
*     ..
*     .. Executable Statements ..
*
      IF( iounit.LE.0 )
     $   RETURN
      c2 = path( 1: 3 )
*
*     First line describing matrices in this path
*
      IF( lsamen( 3, c2, 'GQR' ) ) THEN
         itype = 1
         WRITE( iounit, fmt = 9991 )path
      ELSE IF( lsamen( 3, c2, 'GRQ' ) ) THEN
         itype = 2
         WRITE( iounit, fmt = 9992 )path
      ELSE IF( lsamen( 3, c2, 'LSE' ) ) THEN
         itype = 3
         WRITE( iounit, fmt = 9993 )path
      ELSE IF( lsamen( 3, c2, 'GLM' ) ) THEN
         itype = 4
         WRITE( iounit, fmt = 9994 )path
      ELSE IF( lsamen( 3, c2, 'GSV' ) ) THEN
         itype = 5
         WRITE( iounit, fmt = 9995 )path
      ELSE IF( lsamen( 3, c2, 'CSD' ) ) THEN
         itype = 6
         WRITE( iounit, fmt = 9996 )path
      END IF
*
*     Matrix types
*
      WRITE( iounit, fmt = 9999 )'Matrix types: '
*
      IF( itype.EQ.1 )THEN
         WRITE( iounit, fmt = 9950 )1
         WRITE( iounit, fmt = 9952 )2
         WRITE( iounit, fmt = 9954 )3
         WRITE( iounit, fmt = 9955 )4
         WRITE( iounit, fmt = 9956 )5
         WRITE( iounit, fmt = 9957 )6
         WRITE( iounit, fmt = 9961 )7
         WRITE( iounit, fmt = 9962 )8
      ELSE IF( itype.EQ.2 )THEN
         WRITE( iounit, fmt = 9951 )1
         WRITE( iounit, fmt = 9953 )2
         WRITE( iounit, fmt = 9954 )3
         WRITE( iounit, fmt = 9955 )4
         WRITE( iounit, fmt = 9956 )5
         WRITE( iounit, fmt = 9957 )6
         WRITE( iounit, fmt = 9961 )7
         WRITE( iounit, fmt = 9962 )8
      ELSE IF( itype.EQ.3 )THEN
         WRITE( iounit, fmt = 9950 )1
         WRITE( iounit, fmt = 9952 )2
         WRITE( iounit, fmt = 9954 )3
         WRITE( iounit, fmt = 9955 )4
         WRITE( iounit, fmt = 9955 )5
         WRITE( iounit, fmt = 9955 )6
         WRITE( iounit, fmt = 9955 )7
         WRITE( iounit, fmt = 9955 )8
      ELSE IF( itype.EQ.4 )THEN
         WRITE( iounit, fmt = 9951 )1
         WRITE( iounit, fmt = 9953 )2
         WRITE( iounit, fmt = 9954 )3
         WRITE( iounit, fmt = 9955 )4
         WRITE( iounit, fmt = 9955 )5
         WRITE( iounit, fmt = 9955 )6
         WRITE( iounit, fmt = 9955 )7
         WRITE( iounit, fmt = 9955 )8
      ELSE IF( itype.EQ.5 )THEN
         WRITE( iounit, fmt = 9950 )1
         WRITE( iounit, fmt = 9952 )2
         WRITE( iounit, fmt = 9954 )3
         WRITE( iounit, fmt = 9955 )4
         WRITE( iounit, fmt = 9956 )5
         WRITE( iounit, fmt = 9957 )6
         WRITE( iounit, fmt = 9959 )7
         WRITE( iounit, fmt = 9960 )8
      ELSE IF( itype.EQ.6 )THEN
         WRITE( iounit, fmt = 9963 )1
         WRITE( iounit, fmt = 9964 )2
         WRITE( iounit, fmt = 9965 )3
      END IF
*
*     Tests performed
*
      WRITE( iounit, fmt = 9999 )'Test ratios: '
*
      IF( itype.EQ.1 ) THEN
*
*        GQR decomposition of rectangular matrices
*
         WRITE( iounit, fmt = 9930 )1
         WRITE( iounit, fmt = 9931 )2
         WRITE( iounit, fmt = 9932 )3
         WRITE( iounit, fmt = 9933 )4
      ELSE IF( itype.EQ.2 ) THEN
*
*        GRQ decomposition of rectangular matrices
*
         WRITE( iounit, fmt = 9934 )1
         WRITE( iounit, fmt = 9935 )2
         WRITE( iounit, fmt = 9932 )3
         WRITE( iounit, fmt = 9933 )4
      ELSE IF( itype.EQ.3 ) THEN
*
*        LSE Problem
*
         WRITE( iounit, fmt = 9937 )1
         WRITE( iounit, fmt = 9938 )2
      ELSE IF( itype.EQ.4 ) THEN
*
*        GLM Problem
*
         WRITE( iounit, fmt = 9939 )1
      ELSE IF( itype.EQ.5 ) THEN
*
*        GSVD
*
         WRITE( iounit, fmt = 9940 )1
         WRITE( iounit, fmt = 9941 )2
         WRITE( iounit, fmt = 9942 )3
         WRITE( iounit, fmt = 9943 )4
         WRITE( iounit, fmt = 9944 )5
      ELSE IF( itype.EQ.6 ) THEN
*
*        CSD
*
         WRITE( iounit, fmt = 9910 )
         WRITE( iounit, fmt = 9911 )1
         WRITE( iounit, fmt = 9912 )2
         WRITE( iounit, fmt = 9913 )3
         WRITE( iounit, fmt = 9914 )4
         WRITE( iounit, fmt = 9915 )5
         WRITE( iounit, fmt = 9916 )6
         WRITE( iounit, fmt = 9917 )7
         WRITE( iounit, fmt = 9918 )8
         WRITE( iounit, fmt = 9919 )9
         WRITE( iounit, fmt = 9920 )
         WRITE( iounit, fmt = 9921 )10
         WRITE( iounit, fmt = 9922 )11
         WRITE( iounit, fmt = 9923 )12
         WRITE( iounit, fmt = 9924 )13
         WRITE( iounit, fmt = 9925 )14
         WRITE( iounit, fmt = 9926 )15
      END IF
*
 9999 FORMAT( 1x, a )
 9991 FORMAT( / 1x, a3, ': GQR factorization of general matrices' )
 9992 FORMAT( / 1x, a3, ': GRQ factorization of general matrices' )
 9993 FORMAT( / 1x, a3, ': LSE Problem' )
 9994 FORMAT( / 1x, a3, ': GLM Problem' )
 9995 FORMAT( / 1x, a3, ': Generalized Singular Value Decomposition' )
 9996 FORMAT( / 1x, a3, ': CS Decomposition' )
*
 9950 FORMAT( 3x, i2, ': A-diagonal matrix  B-upper triangular' )
 9951 FORMAT( 3x, i2, ': A-diagonal matrix  B-lower triangular' )
 9952 FORMAT( 3x, i2, ': A-upper triangular B-upper triangular' )
 9953 FORMAT( 3x, i2, ': A-lower triangular B-diagonal triangular' )
 9954 FORMAT( 3x, i2, ': A-lower triangular B-upper triangular' )
*
 9955 FORMAT( 3x, i2, ': Random matrices cond(A)=100, cond(B)=10,' )
*
 9956 FORMAT( 3x, i2, ': Random matrices cond(A)= sqrt( 0.1/EPS ) ',
     $      'cond(B)= sqrt( 0.1/EPS )' )
 9957 FORMAT( 3x, i2, ': Random matrices cond(A)= 0.1/EPS ',
     $      'cond(B)= 0.1/EPS' )
 9959 FORMAT( 3x, i2, ': Random matrices cond(A)= sqrt( 0.1/EPS ) ',
     $      'cond(B)=  0.1/EPS ' )
 9960 FORMAT( 3x, i2, ': Random matrices cond(A)= 0.1/EPS ',
     $      'cond(B)=  sqrt( 0.1/EPS )' )
*
 9961 FORMAT( 3x, i2, ': Matrix scaled near underflow limit' )
 9962 FORMAT( 3x, i2, ': Matrix scaled near overflow limit' )
 9963 FORMAT( 3x, i2, ': Random orthogonal matrix (Haar measure)' )
 9964 FORMAT( 3x, i2, ': Nearly orthogonal matrix with uniformly ',
     $      'distributed angles atan2( S, C ) in CS decomposition' )
 9965 FORMAT( 3x, i2, ': Random orthogonal matrix with clustered ',
     $      'angles atan2( S, C ) in CS decomposition' )
*
*
*     GQR test ratio
*
 9930 FORMAT( 3x, i2, ': norm( R - Q'' * A ) / ( min( N, M )*norm( A )',
     $       '* EPS )' )
 9931 FORMAT( 3x, i2, ': norm( T * Z - Q'' * B )  / ( min(P,N)*norm(B)',
     $       '* EPS )' )
 9932 FORMAT( 3x, i2, ': norm( I - Q''*Q )   / ( N * EPS )' )
 9933 FORMAT( 3x, i2, ': norm( I - Z''*Z )   / ( P * EPS )' )
*
*     GRQ test ratio
*
 9934 FORMAT( 3x, i2, ': norm( R - A * Q'' ) / ( min( N,M )*norm(A) * ',
     $       'EPS )' )
 9935 FORMAT( 3x, i2, ': norm( T * Q - Z'' * B )  / ( min( P,N ) * nor',
     $       'm(B)*EPS )' )
*
*     LSE test ratio
*
 9937 FORMAT( 3x, i2, ': norm( A*x - c )  / ( norm(A)*norm(x) * EPS )' )
 9938 FORMAT( 3x, i2, ': norm( B*x - d )  / ( norm(B)*norm(x) * EPS )' )
*
*     GLM test ratio
*
 9939 FORMAT( 3x, i2, ': norm( d - A*x - B*y ) / ( (norm(A)+norm(B) )*',
     $       '(norm(x)+norm(y))*EPS )' )
*
*     GSVD test ratio
*
 9940 FORMAT( 3x, i2, ': norm( U'' * A * Q - D1 * R ) / ( min( M, N )*',
     $       'norm( A ) * EPS )' )
 9941 FORMAT( 3x, i2, ': norm( V'' * B * Q - D2 * R ) / ( min( P, N )*',
     $       'norm( B ) * EPS )' )
 9942 FORMAT( 3x, i2, ': norm( I - U''*U )   / ( M * EPS )' )
 9943 FORMAT( 3x, i2, ': norm( I - V''*V )   / ( P * EPS )' )
 9944 FORMAT( 3x, i2, ': norm( I - Q''*Q )   / ( N * EPS )' )
*
*     CSD test ratio
*
 9910 FORMAT( 3x, '2-by-2 CSD' )
 9911 FORMAT( 3x, i2, ': norm( U1'' * X11 * V1 - C ) / ( max(  P,  Q)',
     $       ' * max(norm(I-X''*X),EPS) )' )
 9912 FORMAT( 3x, i2, ': norm( U1'' * X12 * V2-(-S)) / ( max(  P,',
     $       'M-Q) * max(norm(I-X''*X),EPS) )' )
 9913 FORMAT( 3x, i2, ': norm( U2'' * X21 * V1 - S ) / ( max(M-P,',
     $       '  Q) * max(norm(I-X''*X),EPS) )' )
 9914 FORMAT( 3x, i2, ': norm( U2'' * X22 * V2 - C ) / ( max(M-P,',
     $       'M-Q) * max(norm(I-X''*X),EPS) )' )
 9915 FORMAT( 3x, i2, ': norm( I - U1''*U1 ) / (   P   * EPS )' )
 9916 FORMAT( 3x, i2, ': norm( I - U2''*U2 ) / ( (M-P) * EPS )' )
 9917 FORMAT( 3x, i2, ': norm( I - V1''*V1 ) / (   Q   * EPS )' )
 9918 FORMAT( 3x, i2, ': norm( I - V2''*V2 ) / ( (M-Q) * EPS )' )
 9919 FORMAT( 3x, i2, ': principal angle ordering ( 0 or ULP )' )
 9920 FORMAT( 3x, '2-by-1 CSD' )
 9921 FORMAT( 3x, i2, ': norm( U1'' * X11 * V1 - C ) / ( max(  P,  Q)',
     $       ' * max(norm(I-X''*X),EPS) )' )
 9922 FORMAT( 3x, i2, ': norm( U2'' * X21 * V1 - S ) / ( max(  M-P,',
     $       'Q) * max(norm(I-X''*X),EPS) )' )
 9923 FORMAT( 3x, i2, ': norm( I - U1''*U1 ) / (   P   * EPS )' )
 9924 FORMAT( 3x, i2, ': norm( I - U2''*U2 ) / ( (M-P) * EPS )' )
 9925 FORMAT( 3x, i2, ': norm( I - V1''*V1 ) / (   Q   * EPS )' )
 9926 FORMAT( 3x, i2, ': principal angle ordering ( 0 or ULP )' )
      RETURN
*
*     End of ALAHDG
*

◆ alareq()

subroutine alareq	(	character*3	path,
		integer	nmats,
		logical, dimension( * )	dotype,
		integer	ntypes,
		integer	nin,
		integer	nout )

ALAREQ

Purpose:

!>
!> ALAREQ handles input for the LAPACK test program.  It is called
!> to evaluate the input line which requested NMATS matrix types for
!> PATH.  The flow of control is as follows:
!>
!> If NMATS = NTYPES then
!>    DOTYPE(1:NTYPES) = .TRUE.
!> else
!>    Read the next input line for NMATS matrix types
!>    Set DOTYPE(I) = .TRUE. for each valid type I
!> endif
!>

Parameters

[in]	PATH	!> PATH is CHARACTER*3 !> An LAPACK path name for testing. !>
[in]	NMATS	!> NMATS is INTEGER !> The number of matrix types to be used in testing this path. !>
[out]	DOTYPE	!> DOTYPE is LOGICAL array, dimension (NTYPES) !> The vector of flags indicating if each type will be tested. !>
[in]	NTYPES	!> NTYPES is INTEGER !> The maximum number of matrix types for this path. !>
[in]	NIN	!> NIN is INTEGER !> The unit number for input. NIN >= 1. !>
[in]	NOUT	!> NOUT is INTEGER !> The unit number for output. NOUT >= 1. !>

Author: Univ. of Tennessee; Univ. of California Berkeley; Univ. of Colorado Denver; NAG Ltd.

Definition at line 89 of file alareq.f.

*
*  -- LAPACK test routine --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
*     .. Scalar Arguments ..
      CHARACTER*3        PATH
      INTEGER            NIN, NMATS, NOUT, NTYPES
*     ..
*     .. Array Arguments ..
      LOGICAL            DOTYPE( * )
*     ..
*
*  =====================================================================
*
*     .. Local Scalars ..
      LOGICAL            FIRSTT
      CHARACTER          C1
      CHARACTER*10       INTSTR
      CHARACTER*80       LINE
      INTEGER            I, I1, IC, J, K, LENP, NT
*     ..
*     .. Local Arrays ..
      INTEGER            NREQ( 100 )
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          len
*     ..
*     .. Data statements ..
      DATA               intstr / '0123456789' /
*     ..
*     .. Executable Statements ..
*
      IF( nmats.GE.ntypes ) THEN
*
*        Test everything if NMATS >= NTYPES.
*
         DO 10 i = 1, ntypes
            dotype( i ) = .true.
   10    CONTINUE
      ELSE
         DO 20 i = 1, ntypes
            dotype( i ) = .false.
   20    CONTINUE
         firstt = .true.
*
*        Read a line of matrix types if 0 < NMATS < NTYPES.
*
         IF( nmats.GT.0 ) THEN
            READ( nin, fmt = '(A80)', END = 90 )line
            lenp = len( line )
            i = 0
            DO 60 j = 1, nmats
               nreq( j ) = 0
               i1 = 0
   30          CONTINUE
               i = i + 1
               IF( i.GT.lenp ) THEN
                  IF( j.EQ.nmats .AND. i1.GT.0 ) THEN
                     GO TO 60
                  ELSE
                     WRITE( nout, fmt = 9995 )line
                     WRITE( nout, fmt = 9994 )nmats
                     GO TO 80
                  END IF
               END IF
               IF( line( i: i ).NE.' ' .AND. line( i: i ).NE.',' ) THEN
                  i1 = i
                  c1 = line( i1: i1 )
*
*              Check that a valid integer was read
*
                  DO 40 k = 1, 10
                     IF( c1.EQ.intstr( k: k ) ) THEN
                        ic = k - 1
                        GO TO 50
                     END IF
   40             CONTINUE
                  WRITE( nout, fmt = 9996 )i, line
                  WRITE( nout, fmt = 9994 )nmats
                  GO TO 80
   50             CONTINUE
                  nreq( j ) = 10*nreq( j ) + ic
                  GO TO 30
               ELSE IF( i1.GT.0 ) THEN
                  GO TO 60
               ELSE
                  GO TO 30
               END IF
   60       CONTINUE
         END IF
         DO 70 i = 1, nmats
            nt = nreq( i )
            IF( nt.GT.0 .AND. nt.LE.ntypes ) THEN
               IF( dotype( nt ) ) THEN
                  IF( firstt )
     $               WRITE( nout, fmt = * )
                  firstt = .false.
                  WRITE( nout, fmt = 9997 )nt, path
               END IF
               dotype( nt ) = .true.
            ELSE
               WRITE( nout, fmt = 9999 )path, nt, ntypes
 9999          FORMAT( ' *** Invalid type request for ', a3, ', type  ',
     $               i4, ': must satisfy  1 <= type <= ', i2 )
            END IF
   70    CONTINUE
   80    CONTINUE
      END IF
      RETURN
*
   90 CONTINUE
      WRITE( nout, fmt = 9998 )path
 9998 FORMAT( /' *** End of file reached when trying to read matrix ',
     $      'types for ', a3, /' *** Check that you are requesting the',
     $      ' right number of types for each path', / )
 9997 FORMAT( ' *** Warning:  duplicate request of matrix type ', i2,
     $      ' for ', a3 )
 9996 FORMAT( //' *** Invalid integer value in column ', i2,
     $      ' of input', ' line:', /a79 )
 9995 FORMAT( //' *** Not enough matrix types on input line', /a79 )
 9994 FORMAT( ' ==> Specify ', i4, ' matrix types on this line or ',
     $      'adjust NTYPES on previous line' )
      WRITE( nout, fmt = * )
      stop
*
*     End of ALAREQ
*

◆ alarqg()

subroutine alarqg	(	character*3	path,
		integer	nmats,
		logical, dimension( * )	dotype,
		integer	ntypes,
		integer	nin,
		integer	nout )

ALARQG

Purpose:

!>
!> ALARQG handles input for the LAPACK test program.  It is called
!> to evaluate the input line which requested NMATS matrix types for
!> PATH.  The flow of control is as follows:
!>
!> If NMATS = NTYPES then
!>    DOTYPE(1:NTYPES) = .TRUE.
!> else
!>    Read the next input line for NMATS matrix types
!>    Set DOTYPE(I) = .TRUE. for each valid type I
!> endif
!>

Parameters

[in]	PATH	!> PATH is CHARACTER*3 !> An LAPACK path name for testing. !>
[in]	NMATS	!> NMATS is INTEGER !> The number of matrix types to be used in testing this path. !>
[out]	DOTYPE	!> DOTYPE is LOGICAL array, dimension (NTYPES) !> The vector of flags indicating if each type will be tested. !>
[in]	NTYPES	!> NTYPES is INTEGER !> The maximum number of matrix types for this path. !>
[in]	NIN	!> NIN is INTEGER !> The unit number for input. NIN >= 1. !>
[in]	NOUT	!> NOUT is INTEGER !> The unit number for output. NOUT >= 1. !>

Author: Univ. of Tennessee; Univ. of California Berkeley; Univ. of Colorado Denver; NAG Ltd.

Definition at line 89 of file alarqg.f.

*
*  -- LAPACK test routine --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
*     .. Scalar Arguments ..
      CHARACTER*3        PATH
      INTEGER            NIN, NMATS, NOUT, NTYPES
*     ..
*     .. Array Arguments ..
      LOGICAL            DOTYPE( * )
*     ..
*
* ======================================================================
*
*     .. Local Scalars ..
      LOGICAL            FIRSTT
      CHARACTER          C1
      CHARACTER*10       INTSTR
      CHARACTER*80       LINE
      INTEGER            I, I1, IC, J, K, LENP, NT
*     ..
*     .. Local Arrays ..
      INTEGER            NREQ( 100 )
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          len
*     ..
*     .. Data statements ..
      DATA               intstr / '0123456789' /
*     ..
*     .. Executable Statements ..
*
      IF( nmats.GE.ntypes ) THEN
*
*        Test everything if NMATS >= NTYPES.
*
         DO 10 i = 1, ntypes
            dotype( i ) = .true.
   10    CONTINUE
      ELSE
         DO 20 i = 1, ntypes
            dotype( i ) = .false.
   20    CONTINUE
         firstt = .true.
*
*        Read a line of matrix types if 0 < NMATS < NTYPES.
*
         IF( nmats.GT.0 ) THEN
            READ( nin, fmt = '(A80)', END = 90 )line
            lenp = len( line )
            i = 0
            DO 60 j = 1, nmats
               nreq( j ) = 0
               i1 = 0
   30          CONTINUE
               i = i + 1
               IF( i.GT.lenp ) THEN
                  IF( j.EQ.nmats .AND. i1.GT.0 ) THEN
                     GO TO 60
                  ELSE
                     WRITE( nout, fmt = 9995 )line
                     WRITE( nout, fmt = 9994 )nmats
                     GO TO 80
                  END IF
               END IF
               IF( line( i: i ).NE.' ' .AND. line( i: i ).NE.',' ) THEN
                  i1 = i
                  c1 = line( i1: i1 )
*
*              Check that a valid integer was read
*
                  DO 40 k = 1, 10
                     IF( c1.EQ.intstr( k: k ) ) THEN
                        ic = k - 1
                        GO TO 50
                     END IF
   40             CONTINUE
                  WRITE( nout, fmt = 9996 )i, line
                  WRITE( nout, fmt = 9994 )nmats
                  GO TO 80
   50             CONTINUE
                  nreq( j ) = 10*nreq( j ) + ic
                  GO TO 30
               ELSE IF( i1.GT.0 ) THEN
                  GO TO 60
               ELSE
                  GO TO 30
               END IF
   60       CONTINUE
         END IF
         DO 70 i = 1, nmats
            nt = nreq( i )
            IF( nt.GT.0 .AND. nt.LE.ntypes ) THEN
               IF( dotype( nt ) ) THEN
                  IF( firstt )
     $               WRITE( nout, fmt = * )
                  firstt = .false.
                  WRITE( nout, fmt = 9997 )nt, path
               END IF
               dotype( nt ) = .true.
            ELSE
               WRITE( nout, fmt = 9999 )path, nt, ntypes
 9999          FORMAT( ' *** Invalid type request for ', a3, ', type  ',
     $               i4, ': must satisfy  1 <= type <= ', i2 )
            END IF
   70    CONTINUE
   80    CONTINUE
      END IF
      RETURN
*
   90 CONTINUE
      WRITE( nout, fmt = 9998 )path
 9998 FORMAT( /' *** End of file reached when trying to read matrix ',
     $      'types for ', a3, /' *** Check that you are requesting the',
     $      ' right number of types for each path', / )
 9997 FORMAT( ' *** Warning:  duplicate request of matrix type ', i2,
     $      ' for ', a3 )
 9996 FORMAT( //' *** Invalid integer value in column ', i2,
     $      ' of input', ' line:', /a79 )
 9995 FORMAT( //' *** Not enough matrix types on input line', /a79 )
 9994 FORMAT( ' ==> Specify ', i4, ' matrix types on this line or ',
     $      'adjust NTYPES on previous line' )
      WRITE( nout, fmt = * )
      stop
*
*     End of ALARQG
*

◆ alasmg()

subroutine alasmg	(	character*3	type,
		integer	nout,
		integer	nfail,
		integer	nrun,
		integer	nerrs )

ALASMG

Purpose:

!>
!> ALASMG prints a summary of results from one of the -CHK- routines.
!>

Parameters

[in]	TYPE	!> TYPE is CHARACTER*3 !> The LAPACK path name. !>
[in]	NOUT	!> NOUT is INTEGER !> The unit number on which results are to be printed. !> NOUT >= 0. !>
[in]	NFAIL	!> NFAIL is INTEGER !> The number of tests which did not pass the threshold ratio. !>
[in]	NRUN	!> NRUN is INTEGER !> The total number of tests. !>
[in]	NERRS	!> NERRS is INTEGER !> The number of error messages recorded. !>

Author: Univ. of Tennessee; Univ. of California Berkeley; Univ. of Colorado Denver; NAG Ltd.

Definition at line 72 of file alasmg.f.

*
*  -- LAPACK test routine --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
*     .. Scalar Arguments ..
      CHARACTER*3        TYPE
      INTEGER            NFAIL, NOUT, NRUN, NERRS
*     ..
*
* ======================================================================
*
*     .. Executable Statements ..
*
      IF( nfail.GT.0 ) THEN
         WRITE( nout, fmt = 9999 )TYPE, NFAIL, NRUN
      ELSE
         WRITE( nout, fmt = 9998 )TYPE, NRUN
      END IF
      IF( nerrs.GT.0 ) THEN
         WRITE( nout, fmt = 9997 )nerrs
      END IF
*
 9999 FORMAT( 1x, a3, ': ', i6, ' out of ', i6,
     $      ' tests failed to pass the threshold' )
 9998 FORMAT( /1x, 'All tests for ', a3,
     $      ' routines passed the threshold ( ', i6, ' tests run)' )
 9997 FORMAT( 6x, i6, ' error messages recorded' )
      RETURN
*
*     End of ALASMG
*

◆ alasum()

subroutine alasum	(	character*3	type,
		integer	nout,
		integer	nfail,
		integer	nrun,
		integer	nerrs )

ALASUM

Purpose:

!>
!> ALASUM prints a summary of results from one of the -CHK- routines.
!>

Parameters

[in]	TYPE	!> TYPE is CHARACTER*3 !> The LAPACK path name. !>
[in]	NOUT	!> NOUT is INTEGER !> The unit number on which results are to be printed. !> NOUT >= 0. !>
[in]	NFAIL	!> NFAIL is INTEGER !> The number of tests which did not pass the threshold ratio. !>
[in]	NRUN	!> NRUN is INTEGER !> The total number of tests. !>
[in]	NERRS	!> NERRS is INTEGER !> The number of error messages recorded. !>

Author: Univ. of Tennessee; Univ. of California Berkeley; Univ. of Colorado Denver; NAG Ltd.

Definition at line 72 of file alasum.f.

*
*  -- LAPACK test routine --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
*     .. Scalar Arguments ..
      CHARACTER*3        TYPE
      INTEGER            NFAIL, NOUT, NRUN, NERRS
*     ..
*
*  =====================================================================
*
*     .. Executable Statements ..
*
      IF( nfail.GT.0 ) THEN
         WRITE( nout, fmt = 9999 )TYPE, NFAIL, NRUN
      ELSE
         WRITE( nout, fmt = 9998 )TYPE, NRUN
      END IF
      IF( nerrs.GT.0 ) THEN
         WRITE( nout, fmt = 9997 )nerrs
      END IF
*
 9999 FORMAT( 1x, a3, ': ', i6, ' out of ', i6,
     $      ' tests failed to pass the threshold' )
 9998 FORMAT( /1x, 'All tests for ', a3,
     $      ' routines passed the threshold ( ', i6, ' tests run)' )
 9997 FORMAT( 6x, i6, ' error messages recorded' )
      RETURN
*
*     End of ALASUM
*

◆ alasvm()

subroutine alasvm	(	character*3	type,
		integer	nout,
		integer	nfail,
		integer	nrun,
		integer	nerrs )

ALASVM

Purpose:

!>
!> ALASVM prints a summary of results from one of the -DRV- routines.
!>

Parameters

[in]	TYPE	!> TYPE is CHARACTER*3 !> The LAPACK path name. !>
[in]	NOUT	!> NOUT is INTEGER !> The unit number on which results are to be printed. !> NOUT >= 0. !>
[in]	NFAIL	!> NFAIL is INTEGER !> The number of tests which did not pass the threshold ratio. !>
[in]	NRUN	!> NRUN is INTEGER !> The total number of tests. !>
[in]	NERRS	!> NERRS is INTEGER !> The number of error messages recorded. !>

Author: Univ. of Tennessee; Univ. of California Berkeley; Univ. of Colorado Denver; NAG Ltd.

Definition at line 72 of file alasvm.f.

*
*  -- LAPACK test routine --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
*     .. Scalar Arguments ..
      CHARACTER*3        TYPE
      INTEGER            NFAIL, NOUT, NRUN, NERRS
*     ..
*
*  =====================================================================
*
*     .. Executable Statements ..
*
      IF( nfail.GT.0 ) THEN
         WRITE( nout, fmt = 9999 )TYPE, NFAIL, NRUN
      ELSE
         WRITE( nout, fmt = 9998 )TYPE, NRUN
      END IF
      IF( nerrs.GT.0 ) THEN
         WRITE( nout, fmt = 9997 )nerrs
      END IF
*
 9999 FORMAT( 1x, a3, ' drivers: ', i6, ' out of ', i6,
     $      ' tests failed to pass the threshold' )
 9998 FORMAT( /1x, 'All tests for ', a3, ' drivers  passed the ',
     $      'threshold ( ', i6, ' tests run)' )
 9997 FORMAT( 14x, i6, ' error messages recorded' )
      RETURN
*
*     End of ALASVM
*

◆ xerbla()

subroutine xerbla	(	character()	srname,
		integer	info )

XERBLA

Purpose:

!>
!> This is a special version of XERBLA to be used only as part of
!> the test program for testing error exits from the LAPACK routines.
!> Error messages are printed if INFO.NE.INFOT or if SRNAME.NE.SRNAMT,
!> where INFOT and SRNAMT are values stored in COMMON.
!>

Parameters

[in]

SRNAME

!>          SRNAME is CHARACTER*(*)
!>          The name of the subroutine calling XERBLA.  This name should
!>          match the COMMON variable SRNAMT.
!>

[in]

INFO

!>          INFO is INTEGER
!>          The error return code from the calling subroutine.  INFO
!>          should equal the COMMON variable INFOT.
!>

Author: Univ. of Tennessee; Univ. of California Berkeley; Univ. of Colorado Denver; NAG Ltd.

Further Details:

!>
!>  The following variables are passed via the common blocks INFOC and
!>  SRNAMC:
!>
!>  INFOT   INTEGER      Expected integer return code
!>  NOUT    INTEGER      Unit number for printing error messages
!>  OK      LOGICAL      Set to .TRUE. if INFO = INFOT and
!>                       SRNAME = SRNAMT, otherwise set to .FALSE.
!>  LERR    LOGICAL      Set to .TRUE., indicating that XERBLA was called
!>  SRNAMT  CHARACTER*(*) Expected name of calling subroutine
!>

Definition at line 74 of file xerbla.f.

*
*  -- LAPACK test routine --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
*     .. Scalar Arguments ..
      CHARACTER*(*)      SRNAME
      INTEGER            INFO
*     ..
*
*  =====================================================================
*
*     .. Scalars in Common ..
      LOGICAL            LERR, OK
      CHARACTER*32       SRNAMT
      INTEGER            INFOT, NOUT
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          len_trim
*     ..
*     .. Common blocks ..
      COMMON             / infoc / infot, nout, ok, lerr
      COMMON             / srnamc / srnamt
*     ..
*     .. Executable Statements ..
*
      lerr = .true.
      IF( info.NE.infot ) THEN
         IF( infot.NE.0 ) THEN
            WRITE( nout, fmt = 9999 )
     $     srnamt( 1:len_trim( srnamt ) ), info, infot
         ELSE
            WRITE( nout, fmt = 9997 )
     $     srname( 1:len_trim( srname ) ), info
         END IF
         ok = .false.
      END IF
      IF( srname.NE.srnamt ) THEN
         WRITE( nout, fmt = 9998 )
     $     srname( 1:len_trim( srname ) ),
     $     srnamt( 1:len_trim( srnamt ) )
         ok = .false.
      END IF
      RETURN
*
 9999 FORMAT( ' *** XERBLA was called from ', a, ' with INFO = ', i6,
     $      ' instead of ', i2, ' ***' )
 9998 FORMAT( ' *** XERBLA was called with SRNAME = ', a,
     $      ' instead of ', a6, ' ***' )
 9997 FORMAT( ' *** On entry to ', a, ' parameter number ', i6,
     $      ' had an illegal value ***' )
*
*     End of XERBLA
*

◆ xlaenv()

subroutine xlaenv	(	integer	ispec,
		integer	nvalue )

XLAENV

Purpose:

!>
!> XLAENV sets certain machine- and problem-dependent quantities
!> which will later be retrieved by ILAENV.
!>

Parameters

[in]

ISPEC

!>          ISPEC is INTEGER
!>          Specifies the parameter to be set in the COMMON array IPARMS.
!>          = 1: the optimal blocksize; if this value is 1, an unblocked
!>               algorithm will give the best performance.
!>          = 2: the minimum block size for which the block routine
!>               should be used; if the usable block size is less than
!>               this value, an unblocked routine should be used.
!>          = 3: the crossover point (in a block routine, for N less
!>               than this value, an unblocked routine should be used)
!>          = 4: the number of shifts, used in the nonsymmetric
!>               eigenvalue routines
!>          = 5: the minimum column dimension for blocking to be used;
!>               rectangular blocks must have dimension at least k by m,
!>               where k is given by ILAENV(2,...) and m by ILAENV(5,...)
!>          = 6: the crossover point for the SVD (when reducing an m by n
!>               matrix to bidiagonal form, if max(m,n)/min(m,n) exceeds
!>               this value, a QR factorization is used first to reduce
!>               the matrix to a triangular form)
!>          = 7: the number of processors
!>          = 8: another crossover point, for the multishift QR and QZ
!>               methods for nonsymmetric eigenvalue problems.
!>          = 9: maximum size of the subproblems at the bottom of the
!>               computation tree in the divide-and-conquer algorithm
!>               (used by xGELSD and xGESDD)
!>          =10: ieee NaN arithmetic can be trusted not to trap
!>          =11: infinity arithmetic can be trusted not to trap
!>          12 <= ISPEC <= 16:
!>               xHSEQR or one of its subroutines,
!>               see IPARMQ for detailed explanation
!>

[in]

NVALUE

!>          NVALUE is INTEGER
!>          The value of the parameter specified by ISPEC.
!>

Author: Univ. of Tennessee; Univ. of California Berkeley; Univ. of Colorado Denver; NAG Ltd.

Definition at line 80 of file xlaenv.f.

*
*  -- LAPACK test routine --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
*     .. Scalar Arguments ..
      INTEGER            ISPEC, NVALUE
*     ..
*
*  =====================================================================
*
*     .. Arrays in Common ..
      INTEGER            IPARMS( 100 )
*     ..
*     .. Common blocks ..
      COMMON             / claenv / iparms
*     ..
*     .. Save statement ..
      SAVE               / claenv /
*     ..
*     .. Executable Statements ..
*
      IF( ispec.GE.1 .AND. ispec.LE.16 ) THEN
         iparms( ispec ) = nvalue
      END IF
*
      RETURN
*
*     End of XLAENV
*

OpenRadioss 2025.1.11 OpenRadioss project