1SUBROUTINE LA_TEST_SGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, WORK, LWORK, INFO )
2!
3!  -- LAPACK95 interface driver routine (version 1.1) --
4!     UNI-C, Denmark,
5!     April 19, 1999
6!
7!  .. Use Statements ..
8   USE LA_PRECISION, ONLY: WP => SP
9   USE F95_LAPACK, ONLY: LA_GELSS
10!  .. Implicit Statement ..
11   IMPLICIT NONE
12!  .. Scalar Arguments ..
13   INTEGER, INTENT(IN) :: M, N, NRHS, LDA, LDB
14   INTEGER, INTENT(INOUT) :: INFO
15   INTEGER, INTENT(IN) :: RANK
16   INTEGER, INTENT(IN) :: LWORK
17   REAL(WP), INTENT(IN) :: RCOND
18!  .. Array Arguments ..
19   REAL(WP), INTENT(INOUT) :: A(1:LDA,1:N), B(1:LDB,1:NRHS)
20   REAL(WP), INTENT(OUT) :: WORK(LWORK)
21   REAL(WP), INTENT(OUT) :: S(1:MIN(M,N))
22
23!  .. Parameters ..
24   CHARACTER(LEN=8),  PARAMETER :: SRNAME = 'LA_GELSS'
25   CHARACTER(LEN=14), PARAMETER :: SRNAMT = 'LA_TEST_SGELSS'
26!  .. Common blocks ..
27   INTEGER :: INFOTC
28   COMMON /LINFO95/ INFOTC
29!  .. Local Scalars ..
30   INTEGER :: I, J, IA1, IA2, IB1, IB2, IS
31!  .. Local Arrays ..
32   LOGICAL, SAVE :: CTEST = .TRUE., ETEST = .TRUE.
33!  .. Executable Statements ..
34   IA1 = M; IA2 = N; IB1 = MAX(1,M,N); IB2 = NRHS; IS = MIN(M,N)
35   I = INFO / 100; J = INFO - I*100
36   SELECT CASE(I)
37   CASE(0)
38      IF (NRHS==1) THEN
39        CALL LA_GELSS( A(1:IA1,1:IA2), B(1:IB1,1), RANK,  &
40     &                      S(1:IS), RCOND, INFO )
41        INFO = INFOTC
42      ELSE
43        CALL LA_GELSS( A(1:IA1,1:IA2), B(1:IB1,1:IB2), RANK, &
44     &                     S(1:IS), RCOND, INFO )
45        INFO = INFOTC
46      ENDIF
47   CASE (2)
48      IB1 = MAX(1, N, M) - 1
49   CASE(4)
50      IS = MIN (M, N) - 1
51   CASE(:-1,1,3, 5:)
52      CALL UESTOP(SRNAMT)
53   END SELECT
54      IF( I /= 0) THEN
55      SELECT CASE (NRHS)
56      CASE (2:)
57         CALL LA_GELSS( A(1:IA1,1:IA2), B(1:IB1,1:IB2), RANK,&
58     &     S(1:IS), RCOND, INFO )
59      CASE(1)
60         CALL LA_GELSS( A(1:IA1,1:IA2), B(1:IB1,1), RANK, &
61     &     S(1:IS), RCOND, INFO)
62      CASE(:-1)
63         CALL UESTOP(SRNAMT)
64      END SELECT
65   END IF
66   CALL LA_AUX_AA01( I, CTEST, ETEST, SRNAMT )
67END SUBROUTINE LA_TEST_SGELSS
68