Kramer's rule
Author Message
Kramer's rule

! I have to build a program for my fortran class, and I need help solving 3x3
! equations by the Kramer's Rule.

Program CramerRule

! Cramer's rule for 3x3 matrices
! Read input file, which contains
! one line per equation with equations written as shown below.
! No space must appear between the sign and the number
! but otherwise separate by blanks:
!       2 x -3 y +4 z = 7
!       5 x -6 y +8 z = 9
!       11 x +13 y +14 z = 15

Integer :: ios, k
Integer, Parameter :: maxFileNameLength = 128
Integer, Parameter :: maxCharBufferLength = 128
Integer, Parameter :: readUnit = 10

Character (maxFileNameLength) :: inputFile, fileName
Character (maxCharBufferLength) :: charBuffer

Real, Dimension (4) :: vector
Real, Dimension (:), Pointer :: A, B, C
Real, Dimension (3, 4), Target :: inputMatrix
Real :: sysdet, xdet, ydet, zdet

Call getarg(1, inputFile)
Open (readUnit, file = inputFile, iostat = ios, action = "READ", status = "OLD")
If (ios /= 0) Then
End If

Do k = 1, 3
Call numberFromBuffer(vector)
inputMatrix(k, 1:4) = vector
End Do

A => inputMatrix(1:3, 1)
B => inputMatrix(1:3, 2)
C => inputMatrix(1:3, 3)
sysdet = Determinant(A, B, C)

A => inputMatrix(1:3, 4)
B => inputMatrix(1:3, 2)
C => inputMatrix(1:3, 3)
xdet = Determinant(A, B, C)

A => inputMatrix(1:3, 1)
B => inputMatrix(1:3, 4)
C => inputMatrix(1:3, 3)
ydet = Determinant(A, B, C)

A => inputMatrix(1:3, 1)
B => inputMatrix(1:3, 2)
C => inputMatrix(1:3, 4)
zdet = Determinant(A, B, C)

If (Abs(sysdet) < 10e-15) Then
Stop "Small System Determinant"
End If

Write (*, *) "Solution x = ", xdet/sysdet
Write (*, *) "Solution y = ", ydet/sysdet
Write (*, *) "Solution z = ", zdet/sysdet

Contains

Function Determinant(A, B, C)
Real, Dimension (:), Intent (in) :: A, B, C
Real :: Determinant
Determinant = - A(3)*B(2)*C(1) + A(2)*B(3)*C(1) + A(3)*B(1)*C(2) &
- A(1)*B(3)*C(2) - A(2)*B(1)*C(3) + A(1)*B(2)*C(3)
End Function Determinant

Subroutine numberFromBuffer(vector)
Real, Dimension (:), Intent (out) :: vector
! Read four numerical values from  charBuffer
Integer :: kount
Character :: c
Do kount = 1, maxCharBufferLength
c = charBuffer(kount:kount)
If ( .Not. DigitQ(c) ) Then
charBuffer(kount:kount) = " "
Else If (c == "=") Then
charBuffer(kount:kount) = " "
End If
End Do
End Subroutine numberFromBuffer

Function DigitQ(char)
Character, Intent (in) :: char
Logical :: DigitQ
Character(len = 13), Parameter :: S = "0123456789.-+"
If (Index(S, char) > 0) Then
DigitQ = .True.
Else
DigitQ = .False.
End If
End Function DigitQ

End Program CramerRule
--
_________________________________________________________________________

University of {*filter*}ia Department of Mechanical and Aerospace Engineering
_________________________________________________________________________

Wed, 18 Jun 1902 08:00:00 GMT

 Page 1 of 1 [ 1 post ]

Relevant Pages