SUBROUTINE CGELSS1_F95( A, B, RANK, S, RCOND, INFO ) ! ! -- LAPACK95 interface driver routine (version 3.0) -- ! UNI-C, Denmark; Univ. of Tennessee, USA; NAG Ltd., UK ! September, 2000 ! ! .. USE STATEMENTS .. USE LA_PRECISION, ONLY: WP => SP USE LA_AUXMOD, ONLY: ERINFO, LA_WS_GELSS USE F77_LAPACK, ONLY: GELSS_F77 => LA_GELSS ! .. IMPLICIT STATEMENT .. IMPLICIT NONE ! .. SCALAR ARGUMENTS .. INTEGER, INTENT(OUT), OPTIONAL :: RANK INTEGER, INTENT(OUT), OPTIONAL :: INFO REAL(WP), INTENT(IN), OPTIONAL :: RCOND ! .. ARRAY ARGUMENTS .. COMPLEX(WP), INTENT(INOUT) :: A(:,:), B(:) REAL(WP), INTENT(OUT), OPTIONAL, TARGET :: S(:) ! .. PARAMETERS .. CHARACTER(LEN=8), PARAMETER :: SRNAME = 'LA_GELSS' CHARACTER(LEN=1), PARAMETER :: VER = 'C' ! .. LOCAL SCALARS .. INTEGER :: LINFO, ISTAT, ISTAT1, LWORK, N, M, MN, NRHS, LRANK, SS REAL(WP) :: LRCOND ! .. LOCAL POINTERS .. REAL(WP), POINTER :: RWORK(:), LS(:) COMPLEX(WP), POINTER :: WORK(:) ! .. INTRINSIC FUNCTIONS .. INTRINSIC SIZE, PRESENT, MAX, MIN, EPSILON ! .. EXECUTABLE STATEMENTS .. LINFO = 0; ISTAT = 0; M = SIZE(A,1); N = SIZE(A,2); NRHS = 1; MN = MIN(M,N) IF( PRESENT(RCOND) )THEN; LRCOND = RCOND; ELSE LRCOND = 100*EPSILON(1.0_WP) ; ENDIF IF( PRESENT(S) )THEN; SS = SIZE(S); ELSE; SS =MN; ENDIF ! .. TEST THE ARGUMENTS IF( M < 0 .OR. N < 0 ) THEN; LINFO = -1 ELSE IF( SIZE( B ) /= MAX(1,M,N) ) THEN; LINFO = -2 ELSE IF( SS /= MN ) THEN; LINFO = -4 ELSE IF( LRCOND <= 0.0_WP ) THEN; LINFO = -5 ELSE IF( PRESENT(S) )THEN; LS => S ELSE; ALLOCATE( LS(MN), STAT = ISTAT ); END IF IF( ISTAT == 0 ) THEN ALLOCATE( RWORK( MAX(1, 5*MIN(M,N) -4)), STAT = ISTAT ) END IF IF( ISTAT == 0 ) THEN LWORK = LA_WS_GELSS( VER, M, N, NRHS ) ALLOCATE( WORK(LWORK), STAT = ISTAT ) IF( ISTAT /= 0 ) THEN DEALLOCATE( WORK, STAT=ISTAT1 ) LWORK = MAX( 1, 2*MIN(M,N) + MAX( M, N, NRHS ) ) ALLOCATE( WORK(LWORK), STAT = ISTAT ) IF( ISTAT /= 0 ) CALL ERINFO( -200, SRNAME, LINFO ) END IF END IF IF ( ISTAT == 0 ) THEN ! .. CALL LAPACK77 ROUTINE CALL GELSS_F77( M, N, NRHS, A, MAX(1,M), B, MAX(1,M,N), & LS, LRCOND, LRANK, WORK, LWORK, RWORK, LINFO ) ELSE; LINFO = -100; END IF IF( PRESENT(RANK) ) RANK = LRANK DEALLOCATE(WORK, RWORK, STAT = ISTAT1 ) END IF CALL ERINFO( LINFO, SRNAME, INFO, ISTAT ) END SUBROUTINE CGELSS1_F95