Gauss Elimination Method (With Pivoting) – Roots of Linear System of Equations | FORTRAN 95

PROGRAM gauss_eli_pivot

IMPLICIT NONE
REAL::A(20,20),k1,k2,v(20),c
INTEGER::i,j,n,k

PRINT *, "============================================" 
PRINT *, "Find roots of linear system of equations using Gauss elimination method (With Pivoting) - [BY - www.BottomScience.com]" 
PRINT *, "============================================"

PRINT *,'GAUSS ELIMINATION - WITH PIVOTING'
PRINT *,'NO. OF ROWS'
READ(*,*)n
PRINT *,'ENTER ELEMENTS'
READ(*,*)((A(i,j),j=1,n+1),i=1,n)

PRINT *,'YOUR MATRIX - '

DO i=1,n
write(*,*)(A(i,j),j=1,n+1)
END DO

DO k=1,n-1
call pivot_sub(A,n,k)
k1=A(k,k)
   DO i=k+1,n
       k2=A(i,k)/k1
       DO j=k,n+1
         A(i,j)=A(i,j)-(k2*A(k,j))
       END DO
   END DO
END DO

PRINT *,'UPPER TRIANGULAR MATRIX - '

DO i=1,n
write(*,*)(A(i,j),j=1,n+1)
END DO

!LAST ELEMENT
v(n)=A(n,n+1)/A(n,n)

!REST OF THE ELEMENTS

DO i=n-1,1,-1
c=0.
DO j=i+1,n
   c=c+A(i,j)*v(j)!DETECTING LAST VALUE
END DO
v(i)=(A(i,n+1)-c)/a(i,i)
END DO

PRINT *,'SOLUTIONS ARE - '

DO i=1,n
write(*,*)v(i)
END DO
END PROGRAM

!PIVOT SUBROUTINE

SUBROUTINE pivot_sub(A1,n,k)
REAL::A1(20,20),big

INTEGER::i,n,k,rn
rn=k
big=abs(A1(k,k))
DO i=k+1,n
   IF((abs(A1(i,k)))>(abs(A1(k,k)))) THEN
     big=A1(i,k)
     rn=i
   END IF
  END DO

IF (rn .ne. k) THEN
DO j=1,n+1
   temp=A1(rn,j)
   A1(rn,j)=A1(k,j)
   A1(k,j)=temp
END DO
END IF
RETURN
END SUBROUTINE