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
    Stop "Input data file not found."
  End If

  Do k = 1, 3
    Read (readUnit, "(a128)") charBuffer
    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
    Read (charBuffer, *) vector
  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  
 
 [ 1 post ] 

 Relevant Pages 

1. Kramer's rule

2. CFP: RULE'02 - PLI-Workshop on Rule-Based Programming

3. CFP: RULE 2001 (2nd Int'l Workshop on Rule-based Programming)

4. CFP: RULE'02 - PLI-Workshop on Rule-Based Programming

5. CFP: RULE 2001 (2nd Int'l Workshop on Rule-based Programming)

6. RFI - Rule sets - pre-built - domain-specific foundation rules - availability or contacts

7. They're just rules

8. Cobb's 12 rules of RDBMS

9. Paice's Conflation Rules

10. Wong's Readable-Forth Rules

11. Wong's Readable Forth Rules

12. a heretical suggestion regarding Pop's lexical rules

 

 
Powered by phpBB® Forum Software