PROGRAM testa_lapack
IMPLICIT NONE
! Usa a sub-rotina SGESV da Lapack - solucao de sistema de equacoes lineares
! www.netlib.org
! Autor: Gilberto Orengo (g.orengo@gmail.com)
! Obs.: os dados, das matrizes, sao oriundas de um Arquivo.
!       O nome do Arquivo eh fornecido pelo usuario
!
!  Declaracao das variaveis
REAL (KIND=4), ALLOCATABLE, DIMENSION(:,:) :: A, B, X
INTEGER (KIND=4), ALLOCATABLE :: IPIV(:)
INTEGER (KIND=4) :: N, NRHS, LDA, LDB, INFO, i, j
CHARACTER (LEN=20) :: nome
!
WRITE(*,*) "O nome do arquivo com os dados (inclua a extensao): "
READ(*,*)nome
!
OPEN(UNIT=30,FILE=nome)
READ(30,*) N
READ(30,*) NRHS
LDA=N
LDB=N
ALLOCATE(A(LDA,N))      ! Alocacao dinamica de memoria da matriz A
ALLOCATE(B(LDB,NRHS))   ! Alocacao dinamica de memoria da matriz B
ALLOCATE(IPIV(N))       ! Alocacao dinamica de memoria do vetor IPIV
!
! Formatacao de saida
10 FORMAT(A,I2,A,I2,A)
20 FORMAT(A,I2,A,I2,A,F8.5)
!
WRITE(*,*) "Matriz A:" ! Le e Escreve a matriz A, para conferencia
DO i=1,LDA
DO j=1,N
READ(30,*)A(i,j)
WRITE(*,20)"A(",i,",",j,"): ",A(i,j)
END DO
END DO
!
WRITE(*,*) "Matriz B:"  ! Le e Escreve a matriz B, para conferencia
DO i=1,LDB
DO j=1,NRHS
READ(30,*)B(i,j)
WRITE(*,20)"B(",i,",",j,"): ",B(i,j)
END DO
END DO
!
! Chamada da sub-rotina da LAPACK
CALL SGESV(N,NRHS,A,LDA,IPIV,B,LDB,INFO)
X=B  ! A matriz B ao sair da sub-rotina traz o resultado X
WRITE(*,*) " "
WRITE(*,*) "RESULTADO:"  ! Escreve o resultado (X)
DO i=1,LDB
DO j=1,NRHS
WRITE(*,20)"X(",i,",",j,"): ",X(i,j)
END DO
END DO
WRITE(*,*) " "
CLOSE(30)
END PROGRAM testa_lapack