PROGRAM ASDASD
IMPLICIT NONE

REAL(8), ALLOCATABLE,DIMENSION(:,:)::Matriz
INTEGER ORDEN

ORDEN=3
ALLOCATE(Matriz(ORDEN,ORDEN))
Matriz(1,1)=2.0; Matriz(1,2)=0.0; Matriz(1,3)=0.0
Matriz(2,1)=1.0; Matriz(2,2)=1.5; Matriz(2,3)=0.0
Matriz(3,1)=0.0; Matriz(3,2)=-3.0; Matriz(3,3)=0.5
CALL INVERSA(Matriz)


CONTAINS

SUBROUTINE ImprimirMat(M)

REAL(8), DIMENSION(:,:), INTENT(IN)::M
INTEGER columna,fila,i,j

fila=SIZE(M,DIM=1)
columna=SIZE(M,DIM=2)
DO i=1, fila
   DO j=1, columna
      write(*,'(F16.5,X)',ADVANCE='NO')M(i,j)
   END DO
   write(*,*)
END DO

END SUBROUTINE

SUBROUTINE CrearMA(M,Ind,Mamp)

REAL(8), DIMENSION(:,:), INTENT(IN)::M,Ind
Real(8), ALLOCATABLE, DIMENSION(:,:)::Mamp
INTEGER orden1,orden2,columna,fila

orden1=SIZE(M,DIM=1)
orden2=SIZE(Ind,DIM=2)
ALLOCATE(Mamp(orden1,orden1+orden2))
DO fila=1, orden1
   DO columna=1, orden1
      Mamp(fila,columna)=M(fila,columna)
   END DO
   DO columna=1, orden2
      Mamp(fila,columna+orden1)=Ind(fila,columna)
   END DO
END DO

END SUBROUTINE

SUBROUTINE GaussJordanINV(M,Ind)

REAL(8), DIMENSION(:,:), INTENT(IN)::M,Ind
Real(8), ALLOCATABLE, DIMENSION(:,:)::Mamp
INTEGER orden,c,fila

orden=SIZE(M,DIM=1)
CALL CrearMA(M,Ind,Mamp)
write(*,*) 'la matriz ampliada es'
CALL ImprimirMat(Mamp)
  DO c=1, orden
    DO fila=1, c-1
       Mamp(fila,c+1:)=Mamp(fila,c+1:)-Mamp(c,c+1:)*Mamp(fila,c)/Mamp(c,c)
       Mamp(fila,c)=0.0
    END DO
    DO fila=c+1, orden
       Mamp(fila,c+1:)=Mamp(fila,c+1:)-Mamp(c,c+1:)*Mamp(fila,c)/Mamp(c,c)
       Mamp(fila,c)=0.0
    END DO
  END DO
  DO c=1, orden
    Mamp(c,1:)=Mamp(c,1:)/Mamp(c,c)
  END DO
write(*,*) 'la matriz despues de GaussJordan es :'
CALL ImprimirMat(Mamp)
DEALLOCATE(Mamp)

END SUBROUTINE

SUBROUTINE CrearMatID(orden,M)

REAL(8),ALLOCATABLE, DIMENSION(:,:)::M
INTEGER orden,i

ALLOCATE(M(orden,orden))
M=0.0
DO i=1,orden
  M(i,i)=1.0
END DO

END SUBROUTINE

SUBROUTINE Inversa(M)

REAL(8),DIMENSION(:,:), INTENT(IN)::M
REAL(8),ALLOCATABLE, DIMENSION(:,:)::MID
INTEGER orden

orden=SIZE(M,DIM=1)
CALL CrearMatID(orden,MID)
CALL GaussJordanINV(M,MID)
DEALLOCATE(MID)

END SUBROUTINE

END PROGRAM