@extract -b incpath.inc
@extract -b @(incd)/type.inc type=@(@type)
@ROUT gglse
PROGRAM LA_@(pre)GGLSE_EXAMPLE
@extract -b @(incd)/header.inc -case0
!  .. Use Statements
   USE LA_PRECISION, ONLY: WP => @(upr)P
   USE F90_LAPACK, ONLY: LA_GGLSE
!  .. Implicit Statement ..
   IMPLICIT NONE
!  .. Parameters ..
 @type sreal dreal
      CHARACTER(LEN=*), PARAMETER :: FMT = '(8(1X,F10.2))'
 @type scplx dcplx
      CHARACTER(LEN=*), PARAMETER :: FMT = '(4(1X,1H(,F7.2,1H,,F7.2,1H):))'
 @type !
   INTEGER, PARAMETER :: NIN=5, NOUT=6
!  .. Local Scalars ..
   INTEGER  :: I, INFO, M, N, P
!  .. Local Arrays ..
   REAL(WP), ALLOCATABLE :: AA(:,:), BB(:,:), CC(:), DD(:)
   @(type)(WP), ALLOCATABLE :: A(:, :), B(:,:), C(:), D(:), X(:)
!  .. Intrinsic Functions ..
   INTRINSIC MATMUL
!  .. Executable Statements ..
   WRITE (NOUT,*) '@(pre)GGLSE Example Program Results'
   READ ( NIN, * )   ! Skip heading in data file
   READ ( NIN, * ) M, N, P
   PRINT *, 'M = ', M, ' N = ', N, ' P = ', P
   ALLOCATE ( A(M,N), AA(M,N), B(P,N), BB(P,N), C(M), CC(M), D(P), DD(P), X(N) )
   READ (NIN,*) AA, BB, CC, DD
   A = AA; B=BB; C = CC; D = DD
   WRITE(NOUT,*) 'The matrix A'
   DO I = 1, M; WRITE (NOUT,FMT) A(I,:); ENDDO
   WRITE(NOUT,*) 'The RHS matrix B:'
   DO I = 1, P; WRITE (NOUT,FMT) B(I,:); ENDDO
   WRITE(NOUT,*) 'The vector C:'; WRITE (NOUT,FMT) C
   WRITE(NOUT,*) 'The vector D:'; WRITE (NOUT,FMT) D
!
   WRITE ( NOUT, * )'--------------------------------------------'
   WRITE ( NOUT, * )
   WRITE ( NOUT, * )'Details of LA_@(pre)GELSE LAPACK Subroutine Results.'
   WRITE ( NOUT, * )
!
   WRITE (NOUT,*)
   WRITE (NOUT,*) 'CALL LA_GGLSE (A, B, C, D, X)'
   A = AA; B=BB; C = CC; D = DD
   CALL LA_GGLSE (A, B, C, D, X)
   WRITE(NOUT,*)' C - MATMUL(AA, X), MATMUL(BB, X), X'
   WRITE (NOUT,FMT) C - MATMUL( AA, X )
   WRITE (NOUT,FMT) MATMUL( BB, X )
   WRITE(NOUT,FMT) X
!
   WRITE (NOUT,*)
   WRITE (NOUT,*) 'CALL LA_GGLSE (A, B, C, D, X, INFO)'
   A = AA; B=BB; C = CC; D = DD
   CALL LA_GGLSE (A, B, C, D, X, INFO)
   WRITE(NOUT,*)'INFO = ', INFO, ' C - MATMUL(AA, X), MATMUL(BB, X), X'
   WRITE (NOUT,FMT) C - MATMUL( AA, X )
   WRITE (NOUT,FMT) MATMUL( BB, X )
   WRITE(NOUT,FMT) X
!
   WRITE (NOUT,*)
   WRITE (NOUT,*) 'CALL LA_GGLSE (A(:,1:N-1), B, C, D, X, INFO)'
   A = AA; B=BB; C = CC; D = DD
   CALL LA_GGLSE (A(:,1:N-1), B, C, D, X, INFO)
   WRITE(NOUT,*)'INFO = ', INFO
!
   WRITE (NOUT,*)
   WRITE (NOUT,*) 'CALL LA_GGLSE (A, B(1:1,:), C, D, X, INFO)'
   A = AA; B=BB; C = CC; D = DD
   CALL LA_GGLSE (A, B(1:1,:), C, D, X, INFO)
   WRITE(NOUT,*)'INFO = ', INFO
!
   WRITE (NOUT,*)
   WRITE (NOUT,*) 'CALL LA_GGLSE (A, B, C(1:1), D, X, INFO)'
   A = AA; B=BB; C = CC; D = DD
   CALL LA_GGLSE (A, B, C(1:1), D, X, INFO)
   WRITE(NOUT,*)'INFO = ', INFO
!
   WRITE (NOUT,*)
   WRITE (NOUT,*) 'CALL LA_GGLSE (A, B, C, D(1:1), X, INFO)'
   A = AA; B=BB; C = CC; D = DD
   CALL LA_GGLSE (A, B, C, D(1:1), X, INFO)
   WRITE(NOUT,*)'INFO = ', INFO
!
   WRITE (NOUT,*)
   WRITE (NOUT,*) 'CALL LA_GGLSE (A, B, C, D, X(1:1))'
   A = AA; B=BB; C = CC; D = DD
   CALL LA_GGLSE (A, B, C, D, X(1:1))
   WRITE(NOUT,*)'INFO = ', INFO
!
END!PROGRAM LA_@(pre)GGLSE_EXAMPLE