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