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

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