SUBROUTINE SGELS1_F95( A, B, TRANS, 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, LSAME, LA_WS_GELS USE F77_LAPACK, ONLY: GELS_F77 => LA_GELS ! .. IMPLICIT STATEMENT .. IMPLICIT NONE ! .. SCALAR ARGUMENTS .. CHARACTER(LEN=1), INTENT(IN), OPTIONAL :: TRANS INTEGER, INTENT(OUT), OPTIONAL :: INFO ! .. ARRAY ARGUMENTS .. REAL(WP), INTENT(INOUT) :: A(:,:), B(:) ! .. PARAMETERS .. CHARACTER(LEN=7), PARAMETER :: SRNAME = 'LA_GELS' CHARACTER(LEN=1), PARAMETER :: VER = 'S' ! .. LOCAL SCALARS .. CHARACTER(LEN=1) :: LTRANS INTEGER :: LINFO, ISTAT, ISTAT1, LWORK, N, M ! .. LOCAL POINTERS .. REAL(WP), POINTER :: WORK(:) ! .. INTRINSIC FUNCTIONS .. INTRINSIC SIZE, PRESENT, MAX, MIN ! .. EXECUTABLE STATEMENTS .. LINFO = 0; ISTAT = 0; M = SIZE(A,1); N = SIZE(A,2) IF( PRESENT(TRANS) )THEN; LTRANS = TRANS; ELSE; LTRANS = 'N'; 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( .NOT.( LSAME(LTRANS,'N') .OR. LSAME(LTRANS,'T') ) )THEN; LINFO = -3 ELSE ! .. CALCULATE THE OPTIMAL WORKSPACE .. LWORK = LA_WS_GELS( VER, M, N, 1, LTRANS ) ALLOCATE( WORK(LWORK), STAT = ISTAT ) IF( ISTAT /= 0 ) THEN DEALLOCATE( WORK, STAT=ISTAT1 ); LWORK = MIN(M,N) + MAX(1,M,N) ALLOCATE( WORK(LWORK), STAT = ISTAT ) IF( ISTAT /= 0 ) CALL ERINFO( -200, SRNAME, LINFO ) END IF IF ( ISTAT == 0 ) THEN ! .. CALL LAPACK77 ROUTINE CALL GELS_F77( LTRANS, M, N, 1, A, MAX(1,M), B, MAX(1,M,N), & WORK, LWORK, LINFO ) ELSE; LINFO = -100; END IF DEALLOCATE(WORK, STAT = ISTAT1 ) END IF CALL ERINFO( LINFO, SRNAME, INFO, ISTAT ) END SUBROUTINE SGELS1_F95