GaussElimination Subroutine

private subroutine GaussElimination(EquaCoef, EquaConst, ThermChimSubTemp, NTC)

Arguments

Type	Intent	Attributes		Name
real(kind=r64),	intent(inout),	DIMENSION(NTC, NTC)	::	EquaCoef
real(kind=r64),	intent(inout),	DIMENSION(NTC)	::	EquaConst
real(kind=r64),	intent(out),	DIMENSION(NTC)	::	ThermChimSubTemp
integer,	intent(in)		::	NTC

Called By

Help

Source Code

GaussElimination

Source Code

 SUBROUTINE GaussElimination(EquaCoef, EquaConst, ThermChimSubTemp, NTC)
          ! SUBROUTINE INFORMATION:

          ! PURPOSE OF THIS SUBROUTINE:
          ! This subroutine sovles linear algebraic equations using Gauss Elimination Method.

          ! METHODOLOGY EMPLOYED:
          ! na

          ! REFERENCES:
          ! na

          ! USE STATEMENTS:

 IMPLICIT NONE    ! Enforce explicit typing of all variables in this routine

          ! SUBROUTINE ARGUMENT DEFINITIONS:
          ! na

          ! SUBROUTINE PARAMETER DEFINITIONS:
          ! na

          ! INTERFACE BLOCK SPECIFICATIONS
          ! na

          ! DERIVED TYPE DEFINITIONS
          ! na

          ! SUBROUTINE LOCAL VARIABLE DECLARATIONS:

  INTEGER, INTENT(IN) :: NTC
  REAL(r64) , DIMENSION(NTC, NTC), INTENT(INOUT) :: EquaCoef
  REAL(r64) , DIMENSION(NTC), INTENT(INOUT) :: EquaConst
  REAL(r64) , DIMENSION(NTC), INTENT(OUT) :: ThermChimSubTemp

  REAL(r64) , DIMENSION(NTC) :: tempor
  REAL(r64)  :: tempb
  REAL(r64)  :: TCvalue
  REAL(r64)  :: TCcoefficient
  INTEGER :: PIVOT
  REAL(r64)  :: ThermalChimSum
  INTEGER                :: ThermChimLoop1
  INTEGER                :: ThermChimLoop2
  INTEGER                :: ThermChimLoop3


  DO ThermChimLoop1=1, NTC

   TCvalue=ABS(EquaCoef(ThermChimLoop1,ThermChimLoop1))
   pivot=ThermChimLoop1
   DO ThermChimLoop2=ThermChimLoop1+1, NTC
    IF (ABS(EquaCoef(ThermChimLoop2,ThermChimLoop1))>TCvalue) THEN
     TCvalue=ABS(EquaCoef(ThermChimLoop2,ThermChimLoop1))
     pivot=ThermChimLoop2
    END IF
   END DO


   IF (pivot /= ThermChimLoop1) THEN
    tempor(ThermChimLoop1:NTC)=EquaCoef(ThermChimLoop1, ThermChimLoop1:NTC)
    tempb=EquaConst(ThermChimLoop1)
    EquaCoef(ThermChimLoop1, ThermChimLoop1:NTC)=EquaCoef(pivot, ThermChimLoop1:NTC)
    EquaConst(ThermChimLoop1)=EquaConst(pivot)
    EquaCoef(pivot, ThermChimLoop1:NTC)=tempor(ThermChimLoop1:NTC)
    EquaConst(pivot)=tempb
   END IF

   DO ThermChimLoop2=ThermChimLoop1+1, NTC
    TCcoefficient=-EquaCoef(ThermChimLoop2,ThermChimLoop1)/EquaCoef(ThermChimLoop1,ThermChimLoop1)
    EquaCoef(ThermChimLoop2, ThermChimLoop1:NTC)=EquaCoef(ThermChimLoop2, ThermChimLoop1:NTC)   &
                                               +TCcoefficient*EquaCoef(ThermChimLoop1, ThermChimLoop1:NTC)
    EquaConst(ThermChimLoop2)=EquaConst(ThermChimLoop2)+TCcoefficient*EquaConst(ThermChimLoop1)
   END DO

  END DO

  ThermChimSubTemp(NTC)=EquaConst(NTC)/EquaCoef(NTC, NTC)
  DO ThermChimLoop2=NTC-1, 1, -1
   ThermalChimSum=0.0d0
   DO ThermChimLoop3=ThermChimLoop2+1, NTC
    ThermalChimSum=ThermalChimSum+EquaCoef(ThermChimLoop2, ThermChimLoop3)*ThermChimSubTemp(ThermChimLoop3)
   END DO
   ThermChimSubTemp(ThermChimLoop2)=(EquaConst(ThermChimLoop2)-ThermalChimSum)/EquaCoef(ThermChimLoop2,ThermChimLoop2)
  END DO

 END SUBROUTINE GaussElimination

All Procedures