1SUBROUTINE LA_TEST_SSPGV( ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, WORK, INFO )
2!
3!  -- LAPACK95 interface driver routine (version 1.1) --
4!     UNI-C, Denmark;
5!     May 5, 1999
6!
7!  .. Use Statements ..
8   USE LA_PRECISION, ONLY: WP => SP
9   USE F95_LAPACK, ONLY: LA_SPGV
10!  .. Implicit Statement ..
11   IMPLICIT NONE
12!  .. Scalar Arguments ..
13   INTEGER, INTENT(IN) :: ITYPE, N, LDZ
14   INTEGER, INTENT(INOUT) :: INFO
15   CHARACTER*1, INTENT(IN) :: JOBZ, UPLO
16!  .. Array Arguments ..
17   REAL(WP), INTENT(INOUT) :: AP(1:N*(N+1)/2), BP( 1:N*(N+1)/2)
18   REAL(WP), INTENT(OUT)::  W(1:N), WORK(1:3*N), Z(1:LDZ, 1:N)
19!  .. Parameters ..
20   CHARACTER(LEN=8),  PARAMETER :: SRNAME = 'LA_SPGV '
21   CHARACTER(LEN=14), PARAMETER :: SRNAMT = 'LA_TEST_SSPGV '
22!  .. Common blocks ..
23   INTEGER :: INFOTC
24   COMMON /LINFO95/ INFOTC
25!  .. Local Scalars ..
26   INTEGER :: I, J, IAP, IW, IBP, IITYPE, IZ1, IZ2
27   CHARACTER*1 :: IUPLO, IJOBZ
28!  .. Local Arrays ..
29   LOGICAL, SAVE :: CTEST = .TRUE., ETEST = .TRUE.
30   LOGICAL LSAME
31!  .. Executable Statements ..
32   IAP = N *(N+1)/2; IUPLO = UPLO; IW = N; IJOBZ = JOBZ
33   IBP = N*(N+1)/2; IITYPE = ITYPE; IZ1 = MAX(1, N); IZ2 = N
34   I = INFO / 100; J = INFO - I*100
35   SELECT CASE(I)
36     CASE (1)
37      IAP = IAP - 1
38     CASE (2)
39       IBP = IAP - 1
40     CASE (3)
41       IW = IW - 1
42     CASE (4)
43       IITYPE = 22
44     CASE (5)
45       IUPLO = 'T'
46     CASE (6)
47       IZ2 = IZ2 - 1
48       IJOBZ = 'V'
49     CASE(:-1,7:)
50       CALL UESTOP(SRNAMT)
51   END SELECT
52   IF (LSAME(IJOBZ, 'V')) THEN
53     CALL LA_SPGV( AP(1:IAP), BP(1:IBP), W(1 :IW), &
54&      IITYPE, IUPLO, Z(1:IZ1, 1: IZ2), INFO )
55   ELSE
56     CALL LA_SPGV( AP(1:IAP), BP(1:IBP), W(1 :IW), &
57&      IITYPE, IUPLO, INFO = INFO )
58   END IF
59
60   CALL LA_AUX_AA01( I, CTEST, ETEST, SRNAMT )
61 END SUBROUTINE LA_TEST_SSPGV
62
63
64