SUBROUTINE DGELSD1_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 => DP USE LA_AUXMOD, ONLY: ERINFO USE F77_LAPACK, ONLY: GELSD_F77 => LA_GELSD, ILAENV_F77 => ILAENV ! .. IMPLICIT STATEMENT .. IMPLICIT NONE ! .. SCALAR ARGUMENTS .. INTEGER, INTENT(OUT), OPTIONAL :: RANK INTEGER, INTENT(OUT), OPTIONAL :: INFO REAL(WP), INTENT(IN), OPTIONAL :: RCOND ! .. ARRAY ARGUMENTS .. REAL(WP), INTENT(INOUT) :: A(:,:), B(:) REAL(WP), INTENT(OUT), OPTIONAL, TARGET :: S(:) ! .. PARAMETERS .. CHARACTER(LEN=8), PARAMETER :: SRNAME = 'LA_GELSD' ! .. LOCAL SCALARS .. INTEGER :: LINFO, ISTAT, LWORK, N, M, MN, LRANK, SS, & & LIWORK, SMLSIZ, NLVL REAL(WP) :: LRCOND ! .. LOCAL POINTERS .. REAL(WP), POINTER :: WORK(:) REAL(WP), POINTER :: LS(:) INTEGER, POINTER :: IWORK(:) REAL(WP) :: WORKMIN(1) INTEGER :: IWORKMIN(1) DOUBLE PRECISION TWO PARAMETER ( TWO = 2.0D0 ) ! .. INTRINSIC FUNCTIONS .. INTRINSIC SIZE, PRESENT, MAX, MIN, EPSILON ! .. EXECUTABLE STATEMENTS .. LINFO = 0; ISTAT = 0; M = SIZE(A,1); N = SIZE(A,2) MN = MIN(M,N) SMLSIZ = ILAENV_F77( 9, 'DGELSD', ' ', 0, 0, 0, 0 ) NLVL = INT( LOG( DBLE( MAX(1,MN) ) / DBLE( SMLSIZ+1 ) ) / LOG( TWO ) ) LIWORK = 3*MAX(M,N)*(3 * NLVL + 11 ) 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, 1 ) /= 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 ); IF (ISTAT /= 0) THEN LINFO = -100 GOTO 100 ENDIF END IF ! .. DETERMINE THE WORKSPACE .. ! .. QUERING THE SIZE OF WORKSPACE .. LWORK = -1 CALL GELSD_F77( M, N, 1, A, MAX(1,M), B, MAX(1,M,N), & & LS, LRCOND, LRANK, WORKMIN, LWORK, IWORKMIN, LINFO ) LWORK = WORKMIN(1) ALLOCATE( WORK(LWORK), STAT = ISTAT ) IF (ISTAT /= 0) THEN LINFO = -100 GOTO 200 ENDIF ALLOCATE( IWORK(LIWORK), STAT = ISTAT ) IF (ISTAT /= 0) THEN LINFO = -100 GOTO 250 ENDIF CALL GELSD_F77( M, N, 1, A, MAX(1,M), B, SIZE(B,1), & & LS, LRCOND, LRANK, WORK, LWORK, IWORK, LINFO ) IF( PRESENT(RANK) ) RANK = LRANK 300 DEALLOCATE(IWORK) 250 DEALLOCATE(WORK) 200 IF (.NOT. PRESENT(S)) DEALLOCATE(LS) ENDIF 100 CALL ERINFO( LINFO, SRNAME, INFO, ISTAT ) END SUBROUTINE DGELSD1_F95