Skip to content

Instantly share code, notes, and snippets.

@mkawserm

mkawserm/A01.F90

Last active August 29, 2015 14:01
Show Gist options
  • Save mkawserm/a46fdf9fe856efb97d39 to your computer and use it in GitHub Desktop.
Save mkawserm/a46fdf9fe856efb97d39 to your computer and use it in GitHub Desktop.
Download ZIP
Solve Linear system using Gaussian elimination with pivot [actually partial pivot] and without pivot [ actually interchange the row with the next non zero row if the diagonal element is 0 ] using FORTRAN 90 /95
Raw
A01.F90
!Name : GAUSSIAN ELIMINATION
!Author : KAWSER
!Blog : http://blog.kawser.org
!Created : 15/05/2014 11:23 AM
!Updated : 19/05/2014 10:18 PM
!
!Short URL : http://goo.gl/V0QEg6
!
!Purpose : Solve Linear system using Gaussian elimination with pivot [actually partial pivot]
! and without pivot [actually interchange the row with the next non zero row if the
! diagonal element is 0 ]
!
!
!
! SAMPLE INPUT FILE "A01.txt"
! 3
! 3.3330 15920 10.333 7953
! 2.2220 16.710 9.6120 0.965
! -1.5611 5.1792 -1.6855 2.714
!
PROGRAM A01
IMPLICIT NONE
INTEGER::N !DIMENSION OF THE MATRIX
REAL,ALLOCATABLE,DIMENSION(:,:)::AUGMENTED !AUGMENTED MATRIX
REAL,ALLOCATABLE,DIMENSION(:,:)::REDUCED !REDUCED MATRIX
REAL,ALLOCATABLE,DIMENSION(:)::X !SOLUTION OF THE SYSTEM
LOGICAL::GE_WITHOUT_PIVOT,GE_WITH_PIVOT,R
INTEGER::ROW,COLUMN
OPEN(10 , FILE = "A01.txt") !OPENING INPUT FILE
OPEN(20 , FILE = "A01_OUT.txt") !OPENING OUTPUT FILE
READ(10,*) N !READING THE DIMENSION OF THE MATRIX FROM THE FILE
ALLOCATE( AUGMENTED(N,N+1) , REDUCED(N,N+1) , X(N) ) !ALLOCATING MEMORY FOR THE AUGMENTED,REDUCED MATRIX AND SOLUTION VECTOR X
!READING THE AUGMENTED MATRIX
READ(10,*) ( ( AUGMENTED(ROW,COLUMN) , COLUMN=1 , N+1 ) , ROW=1 , N)
100 FORMAT(1X,F10.3) !THIS FORMATTING STYLE IS USED TO FORMAT THE MATRIX PROPERLY
WRITE(20,*) "#-------------------- AUGMENTED MATRIX A|b ----------------------------------------#"
DO ROW = 1,N
DO COLUMN = 1,N+1
WRITE(20,100,ADVANCE='NO') AUGMENTED(ROW,COLUMN)
END DO
WRITE(20,*) !MOVE WRITE CURSOR TO NEW LINE
END DO
WRITE(20,*) !MOVE WRITE CURSOR TO NEW LINE
WRITE(20,*) "#--------------------- GUSSIAN ELIMINATION WITHOUT PIVOT ---------------------------#"
!CALLING THE GE WITHOUT PIVOT FUNCTION
R = GE_WITHOUT_PIVOT(N,AUGMENTED,REDUCED,X)
IF( R .EQV. .TRUE. ) THEN
WRITE(20,*) "REDUCED MATRIX A|b"
DO ROW = 1,N
DO COLUMN = 1,N+1
WRITE(20,100,ADVANCE='NO') REDUCED(ROW,COLUMN)
END DO
WRITE(20,*) !MOVE WRITE CURSOR TO NEW LINE
END DO
WRITE(20,*) "SOLUTION X"
DO ROW=1,N
WRITE(20,100,ADVANCE="NO") X(ROW)
END DO
WRITE(20,*) !MOVE WRITE CURSOR TO NEW LINE
ELSE
WRITE(20,*) "SORRY THE SYSTEM IS INCONSISTENT OR HAS NO UNIQUE SOLUTION"
END IF
WRITE(20,*) !MOVE WRITE CURSOR TO NEW LINE
WRITE(20,*) !MOVE WRITE CURSOR TO NEW LINE
WRITE(20,*) "#--------------------- GUSSIAN ELIMINATION WITH PIVOT ------------------------------#"
!CALLING THE GE WITH PIVOT FUNCTION
R = GE_WITH_PIVOT(N,AUGMENTED,REDUCED,X)
IF( R .EQV. .TRUE. ) THEN
WRITE(20,*) "REDUCED MATRIX A|b"
DO ROW = 1,N
DO COLUMN = 1,N+1
WRITE(20,100,ADVANCE='NO') REDUCED(ROW,COLUMN)
END DO
WRITE(20,*) !MOVE WRITE CURSOR TO NEW LINE
END DO
WRITE(20,*) "SOLUTION X"
DO ROW=1,N
WRITE(20,100,ADVANCE="NO") X(ROW)
END DO
WRITE(20,*) !MOVE WRITE CURSOR TO NEW LINE
ELSE
WRITE(20,*) "SORRY THE SYSTEM IS INCONSISTENT OR HAS NO UNIQUE SOLUTION"
END IF
DEALLOCATE( AUGMENTED , REDUCED , X ) !DEALLOCATING ALLOCATED MEMORY
CLOSE(10) !CLOSING INPUT FILE
CLOSE(20) !CLOSING OUTPUT FILE
END PROGRAM
LOGICAL FUNCTION GE_WITHOUT_PIVOT(N,AUGMENTED,REDUCED,X)
IMPLICIT NONE
INTEGER,INTENT(IN)::N
REAL,INTENT(IN),DIMENSION(N,N+1)::AUGMENTED
REAL,INTENT(OUT),DIMENSION(N,N+1)::REDUCED
REAL,INTENT(OUT),DIMENSION(N)::X
REAL::T !IT WILL BE USED FOR DIFFERENT PURPOSES
INTEGER::I,J,K !LOOP VARIABLES
REDUCED = AUGMENTED !SET THE MATRIX WHICH WE WANT TO REDUCE
!START ELIMINATION PROCESS
DO I=1,N-1
IF( REDUCED(I,I) == 0.0 ) THEN
!SEARCHING FOR NON ZERO PIVOT ELEMENT
DO J=I+1,N
IF ( REDUCED(J,I) /= 0.0 ) THEN
!NOW INTERCHANGE J'TH ROW WITH I'TH ROW
DO K=1,N+1
T = REDUCED(J,K) !USING T AS TEMPORARY VARIABLE
REDUCED(J,K) = REDUCED(I,K)
REDUCED(I,K) = T
END DO
!ROW INTERCHAGE IS DONE SO WE DON'T NEED TO COMPLETE THE J LOOP
EXIT
END IF
END DO
END IF
!IF STILL REDUCED(I,I) IS ZERO THEN NO SOLUTION EXISTS
IF (REDUCED(I,I) == 0.0 ) THEN
GE_WITHOUT_PIVOT = .FALSE.
RETURN
ELSE
!THIS IS THE ACTUAL ELIMINATION CALCULATION
DO J=I+1,N
T = REDUCED(J,I) / REDUCED(I,I) !USING T AS M
DO K=1,N+1
REDUCED(J,K) = REDUCED(J,K) - T * REDUCED(I,K)
END DO
END DO
END IF
END DO !END OF ELIMINATION PROCESS
!CHECK THE CONSISTENCY OF THE SYSTEM
IF ( REDUCED(N,N) == 0.0 .AND. REDUCED(N,N+1) /= 0.0 ) THEN
GE_WITHOUT_PIVOT = .FALSE.
RETURN
ELSE IF ( REDUCED(N,N) == 0.0 .AND. REDUCED(N,N+1) == 0.0 ) THEN
!NO UNIQUE SOLUTION
GE_WITHOUT_PIVOT = .FALSE.
RETURN
ELSE
!NOW START BACK SUBSTITUTION
X(N) = REDUCED(N,N+1) / REDUCED(N,N)
DO I=N-1,1,-1
T = 0.0 !USING T AS SUM
DO J=I+1,N
T = T + REDUCED(I,J) * X(J)
END DO
X(I) = ( REDUCED(I,N+1) - T ) / REDUCED(I,I)
END DO
GE_WITHOUT_PIVOT = .TRUE.
RETURN
END IF
END FUNCTION
LOGICAL FUNCTION GE_WITH_PIVOT(N,AUGMENTED,REDUCED,X)
IMPLICIT NONE
INTEGER,INTENT(IN)::N
REAL,INTENT(IN),DIMENSION(N,N+1)::AUGMENTED
REAL,INTENT(OUT),DIMENSION(N,N+1)::REDUCED
REAL,INTENT(OUT),DIMENSION(N)::X
REAL::MAX_NUMBER
INTEGER::P !POSITION OF THE MAXIMUM NUMBER
REAL::T !IT WILL BE USED FOR DIFFERENT PURPOSES
INTEGER::I,J,K !LOOP VARIABLES
REDUCED = AUGMENTED !SET THE MATRIX WHICH WE WANT TO REDUCE
!START ELIMINATION PROCESS
DO I=1,N-1
!SEARCH FOR MAX PIVOT ELEMENT
MAX_NUMBER = ABS( REDUCED(I,I) )
P = I
DO J=I,N
IF ( MAX_NUMBER < ABS( REDUCED(J,I) ) ) THEN
MAX_NUMBER = ABS ( REDUCED(J,I) )
P = J
END IF
END DO
!INTERCHANGE THE I'TH ROW WITH P'TH ROW
IF ( I /= P ) THEN
DO K=1,N+1
T = REDUCED(P,K)
REDUCED(P,K) = REDUCED(I,K)
REDUCED(I,K) = T
END DO
END IF
!IF STILL REDUCED(I,I) IS ZERO THEN NO SOLUTION EXISTS
IF ( REDUCED(I,I) == 0.0 ) THEN
GE_WITH_PIVOT = .FALSE.
RETURN
ELSE
!THIS IS THE ACTUAL ELIMINATION CALCULATION
DO J=I+1,N
T = REDUCED(J,I) / REDUCED(I,I) !USINNG T AS M
DO K=1,N+1
REDUCED(J,K) = REDUCED(J,K) - T * REDUCED(I,K)
END DO
END DO
END IF
END DO !END OF ELIMINATION PROCESS
!CHECK THE CONSISTENCY OF THE SYSTEM
IF ( REDUCED(N,N) == 0.0 .AND. REDUCED(N,N+1) /= 0.0 ) THEN
GE_WITH_PIVOT = .FALSE.
RETURN
ELSE IF ( REDUCED(N,N) == 0.0 .AND. REDUCED(N,N+1) == 0.0 ) THEN
!NO UNIQUE SOLUTION
GE_WITH_PIVOT = .FALSE.
RETURN
ELSE
!NOW START BACK SUBSTITUTION
X(N) = REDUCED(N,N+1) / REDUCED(N,N)
DO I=N-1,1,-1
T = 0.0 !USING T AS SUM
DO J=I+1,N
T = T + REDUCED(I,J) * X(J)
END DO
X(I) = ( REDUCED(I,N+1) - T ) / REDUCED(I,I)
END DO
GE_WITH_PIVOT = .TRUE.
RETURN
END IF
END FUNCTION
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment