Golden Section Search Method: Fortran f90

Consider the nonlinear equation f(x)=4x² –exp(x). Write a Fortran program that uses the Golden Section Search Method to find the solution accurate to within 10^-6 for the nonlinear equation on [4,8]. 

Sauce Code:

Program  Assignmentq2

implicit none

real:: f

real::x, r, q1, q2,a, b, tol=1.0e-6

!Define Interval and Function

f(x) = 4*x**2-exp(x)

a=4

b=8

print*, "a", a, "b", b

!Evaluation of the function at the end point

r=(sqrt(5.0)-1)/2

q1=b-r*(b-a)

q2=a+r*(b-a)

 print*, "q1",q1, "q2", q2

 ! Creating Loop

!if ((b-a)<=tol) stop

do while ((b-a)>tol)

     !if(f(a)*f(b)<=0) then

     if(f(a)*f(q2)<=0) then

         b=q2

         q2=q1

         q1=b-r*(b-a)

     else

         a=q1

         q1=q2

         q2=a+r*(b-a)

    print*, "q1",q1, "q2", q2, "a", a, "b", b

     end if 

     end do

end program assignmentq2 

Read More

Gaussian Elimination Method: Fortran f90

 Question:

Solve the following system of linear equations using Gaussian Elimination using Fortran.

x₁ + x₂ - x₃ + x₄ - x₅ = 2

2x₁+ 2 x₂ + x₃ - x₄ + x₅ = 4

3x₁ + x₂-3 x₃ -2x₄+ 3 x₅ = 8

4x₁ + x₂ - x₃ +4 x₄ -5x₅ =16

16x₁ -x₂ + x₃ - x₄ - x₅ =32

 

Solution:

program main

implicit none

integer, parameter :: n=5

double precision:: a(n,n), b(n), x(n)

integer:: i,j

! matrix A

  data (a(1,i), i=1,5) /  1.0,  1.0,  -1.0, 1.0, -1.0 /

  data (a(2,i), i=1,5) /  2.0,  2.0,  1.0, -1.0, 1.0 /

  data (a(3,i), i=1,5) /  3.0,  1.0,  -3.0, -2.0, 3.0 /

  data (a(4,i), i=1,5) /  4.0,  1.0,  -1.0, 4.0, -5.0 /

  data (a(5,i), i=1,5) /  16.0, -1.0, 1.0, -1.0, -1.0 /

! matrix b

  data (b(i),   i=1,5) /  2.0, 4.0, 8.0, 16.0, 32.0 /

! print a header and the original equations

  write (*,200)

  do i=1,n

     write (*,201) (a(i,j),j=1,n), b(i)

  end do

  call gauss_2(a,b,x,n)

! print matrix A and vector b after the elimination 

  write (*,202)

  do i = 1,n

     write (*,201)  (a(i,j),j=1,n), b(i)

  end do

! print solutions

  write (*,203)

  write (*,201) (x(i),i=1,n)

200 format (' Gauss elimination with scaling and pivoting ' &

    ,/,/,' Matrix A and vector b')

201 format (6f12.6)

202 format (/,' Matrix A and vector b after elimination')

203 format (/,' Solutions x(n)')

end

subroutine gauss_2(a,b,x,n)

implicit none 

integer:: n

double precision:: a(n,n), b(n), x(n)

double precision:: s(n)

double precision:: c, pivot, store

integer:: i, j, k, l

! step 1: begin forward elimination

do k=1, n-1

! step 2: "scaling"

! s(i) will have the largest element from row i 

  do i=k,n                       

    s(i) = 0.0

    do j=k,n                    

      s(i) = max(s(i),abs(a(i,j)))

    end do

  end do

! "pivoting 1" 

! row with the largest pivoting element

  pivot = abs(a(k,k)/s(k))

  l = k

  do j=k+1,n

    if(abs(a(j,k)/s(j)) > pivot) then

      pivot = abs(a(j,k)/s(j))

      l = j

    end if

  end do

! Check if the system has a sigular matrix

  if(pivot == 0.0) then

    write(*,*) ' The matrix is sigular '

    return

  end if

! "pivoting 2" interchange rows k and l (if needed)

if (l /= k) then

  do j=k,n

     store = a(k,j)

     a(k,j) = a(l,j)

     a(l,j) = store

  end do

  store = b(k)

  b(k) = b(l)

  b(l) = store

end if

! elimination (after scaling and pivoting)

   do i=k+1,n

      c=a(i,k)/a(k,k)

      a(i,k) = 0.0

      b(i)=b(i)- c*b(k)

      do j=k+1,n

         a(i,j) = a(i,j)-c*a(k,j)

      end do

   end do

end do

! backward substitution 

x(n) = b(n)/a(n,n)

do i=n-1,1,-1

   c=0.0

   do j=i+1,n

     c= c + a(i,j)*x(j)

   end do 

   x(i) = (b(i)- c)/a(i,i)

end do

end subroutine gauss_2

Read More