1 SUBROUTINE SGELSS1_F95( A, B, RANK, S, RCOND, INFO )
2!
3!  -- LAPACK95 interface driver routine (version 3.0) --
4!     UNI-C, Denmark; Univ. of Tennessee, USA; NAG Ltd., UK
5!     September, 2000
6!
7!   .. USE STATEMENTS ..
8    USE LA_PRECISION, ONLY: WP => SP
9    USE LA_AUXMOD, ONLY: ERINFO, LA_WS_GELSS
10    USE F77_LAPACK, ONLY: GELSS_F77 => LA_GELSS
11!   .. IMPLICIT STATEMENT ..
12    IMPLICIT NONE
13!   .. SCALAR ARGUMENTS ..
14    INTEGER, INTENT(OUT), OPTIONAL :: RANK
15    INTEGER, INTENT(OUT), OPTIONAL :: INFO
16    REAL(WP), INTENT(IN), OPTIONAL :: RCOND
17!   .. ARRAY ARGUMENTS ..
18    REAL(WP), INTENT(INOUT) :: A(:,:), B(:)
19    REAL(WP), INTENT(OUT), OPTIONAL, TARGET :: S(:)
20!   .. PARAMETERS ..
21    CHARACTER(LEN=8), PARAMETER :: SRNAME = 'LA_GELSS'
22    CHARACTER(LEN=1), PARAMETER :: VER = 'S'
23!   .. LOCAL SCALARS ..
24    INTEGER :: LINFO, ISTAT, ISTAT1, LWORK, N, M, MN, NRHS, LRANK, SS
25    REAL(WP) :: LRCOND
26!   .. LOCAL POINTERS ..
27    REAL(WP), POINTER :: WORK(:), LS(:)
28!   .. INTRINSIC FUNCTIONS ..
29    INTRINSIC SIZE, PRESENT, MAX, MIN, EPSILON
30!   .. EXECUTABLE STATEMENTS ..
31    LINFO = 0; ISTAT = 0; M = SIZE(A,1); N = SIZE(A,2); NRHS = 1; MN = MIN(M,N)
32    IF( PRESENT(RCOND) )THEN; LRCOND = RCOND; ELSE
33        LRCOND = 100*EPSILON(1.0_WP) ; ENDIF
34    IF( PRESENT(S) )THEN; SS = SIZE(S); ELSE; SS =MN; ENDIF
35!   .. TEST THE ARGUMENTS
36    IF( M < 0 .OR. N < 0 ) THEN; LINFO = -1
37    ELSE IF( SIZE( B ) /= MAX(1,M,N) ) THEN; LINFO = -2
38    ELSE IF( SS /= MN ) THEN; LINFO = -4
39    ELSE IF( LRCOND <= 0.0_WP ) THEN; LINFO = -5
40    ELSE
41       IF( PRESENT(S) )THEN; LS => S
42       ELSE; ALLOCATE( LS(MN), STAT = ISTAT ); END IF
43       IF( ISTAT == 0 ) THEN
44          LWORK = LA_WS_GELSS( VER, M, N, NRHS )
45          ALLOCATE( WORK(LWORK), STAT = ISTAT )
46          IF( ISTAT /= 0 ) THEN
47             DEALLOCATE( WORK, STAT=ISTAT1 )
48             LWORK = MAX( 1, 3*MIN(M,N) + MAX( 2*MIN(M,N), MAX(M,N), NRHS ) )
49             ALLOCATE( WORK(LWORK), STAT = ISTAT )
50             IF( ISTAT /= 0 ) CALL ERINFO( -200, SRNAME, LINFO )
51          END IF
52       END IF
53       IF ( ISTAT == 0 ) THEN
54!      .. CALL LAPACK77 ROUTINE
55          CALL GELSS_F77( M, N, NRHS, A, MAX(1,M), B, MAX(1,M,N), &
56                         LS, LRCOND, LRANK, WORK, LWORK, LINFO )
57       ELSE; LINFO = -100; END IF
58       IF( PRESENT(RANK) ) RANK = LRANK
59       DEALLOCATE(WORK, STAT = ISTAT1 )
60    END IF
61    CALL ERINFO( LINFO, SRNAME, INFO, ISTAT )
62 END SUBROUTINE SGELSS1_F95
63