# Need outputs for fortran 77 programs

1. Feb 9, 2009

### RC_rocks

hi

i need fortran program outputs very urgently.
i have the programs , but i'll not able to run the compiler.

can someone please post the complete outputs for these programs..

THANK YOU

Code (Text):
Program 15:
Program to interpolate a value of dependent variable ‘y’ for a given value of independent ‘x’ using Lagrangian Interpolation Method

real y [allocatable](:), x [allocatable](:)
real product, sum, xx
integer n, i, j, error
write (*, ‘(1x,a\)’) ‘Number of tabulated points (n): ’
allocate (x (n), y(n), stat = error)
if (error .ne. 0) stop ‘Not enough memory’
write (*, ‘(/1x, a, i2, a)’) ‘Enter ‘,n,’ pairs of (x,y)’
read (*,*) ( x(i), y(i), i =, n)
write (*, ‘(1x, a\)’) ‘Enter value of x for interpolation: ’
if ((xx .lt. x(1)) .or. (xx .gt. x(n))) then
stop ‘Value outside tabulated range’
endif
sum = 0.0
do i = 1, n
product = 1.0
do j = 1, n
if (i .ne. j) then
product = product * ((xx-x(j))/(x(i)-x(j)))
endif
enddo
sum = sum + y(i) * product
enddo
write (*,50) sum, xx
50  format (1x, ‘Interpolated value of y =’, f8.3, ‘for x = ’, f6.3)
deallocate (x, y, stat = error)
if (error .ne. 0) stop ‘Error in releasing memory’
end

Output:

Program 16:
Program to find the solution of a linear system of equations by Gauss Jordan method

real a [allocatable] (: , :)
integer n, k, i, j, error
write (*, ‘(1x,a\)’) ‘Enter number of equations (n): ’
allocate (a(n, n+1), x(n), stat = error)
if (error .ne. 0) stop ‘Not enough memory’
write (*,*) ‘Enter coefficients equation wise’
read (*,*) ((a(i,j), j = 1, n+1), i = 1, n)
do k = 1, n
temp = a (k,k)
if (temp .eq. 0) stop ‘Pivot element becomes zero’
do j = k, n+1
a (k,j) = a (k,j)/temp
enddo
do i = 1, n
if (i .ne. k) then
temp = a (i,k)
do j = k, n+1
a (i.j) = a (i,j) - temp * a (k,j)
enddo
endif
enddo
enddo
write (*,*) ‘The solution of the system of the equations is: ’
do i = 1, n
write (*, ‘(1x, ‘x(‘, i2, ’) = ‘, f7.3)’) i, a(i, n+1)
enddo
deallcoate (a, stat = error)
if (error .ne. 0) stop ‘Error in releasing memory’
end

Output:

Program 17:
Program to find the solution of a linear system of equations by Gauss-Elimination method
Equation:-

real a [allocatable] (: , :), x [allocatable] (:), temp1, temp2
real sum
integer n, k, i, j, error
write (*, ‘(1x,a\)’) ‘Enter number of equations (n): ’
allocate (a(n, n+1), x(n), stat = error)
if (error .ne. 0) stop ‘Not enough memory’
write (*,*) ‘Enter coefficients equation wise’
read (*,*) ((a(i,j), j = 1, n+1), i = 1, n)
do k = 1, n-1
temp1 = a (k,k)
if (temp1 .eq. 0) stop ‘Zero division’
do i = k+1, n
temp2 = a (i,k)/temp1
do j = k, n+1
a (i.j) = a (i,j) - temp2 * a (k,j)
enddo
enddo
enddo
x(n) = a(n,n+1)/a(n,n)
do i = n-1, 1, -1
sum = 0.0
do j = i+1, n
sum = sum + a(i,j) * x(j)
enddo
x(i) = (a(i,n+1)-sum)/a(i,i)
enddo
write(*,*) ‘Solution of the system of the equations is: ’
do i = 1, n
write (*,15) i, x(i)
15      format (1x, ‘x(‘, i2, ’) = ’, f7.3)
enddo
deallcoate (a, x, stat = error)
if (error .ne. 0) stop ‘Error in releasing memory’
end
Output:

Program 18:
Program to integrate a known function using Trapezoidal Rule

real a, b, sum, h, integral, f
integer n, i
f(x) = x + 5
write (*, ‘(1x, a\)’) ‘Lower limit of integration (a): ’
write (*, ‘(1x, a\)’) ‘Upper limit of integration (b): ’
write (*, ‘(1x, a\)’) ‘Number of intervals (n): ’
h = (b-a)/n
sum = (f(a) + f(b))/2
do i = 1, n-1
sum = sum + f(a+i*h)
enddo
integral = h*sum
write (*, ‘(//1x, a, f6.3)’) “Value of integral: ”, integral
end

OUTPUT:-

Program 19:
Program to integrate a known function using Simspon’s 1/3rd Rule

real a, b, sum, sum2, sum4, h, integral, f
integer n, i
f(x) = x**2+3*x+5
write (*, ‘(1x, a\)’) ‘Lower limit of integration (a): ’
write (*, ‘(1x, a\)’) ‘Upper limit of integration (b): ’
write (*, ‘(1x, a\)’) ‘Number of intervals (n): ’
h = (b-a)/n
sum = f(a) + f(b)
sum2 = 0
sum4 = 0
do i = 1, n-2, 2
sum4 = sum4 +f(a+i*h)
sum2 = sum2 +f(a+(i+1)*h)
enddo
integral  = (h/3)*(sum + 2*sum2 + 4*sum4)
write (*, ‘(//1x, a, f6.3)’) “Value of integral =”, integral
end

OUTPUT:-

Program 20:
Program to solve a first order differential equation using Runge-Kutta (Heun’s) second order method

real s1, s2, x1, xf, y1, x, y, h, f
integer i
f(x,y) = x*y
write (*, ‘(1x, a\)’) ‘Starting solution point (x1,y1): ’
write (*, ‘(1x, a\)’) ‘Last point of the interval (xf): ’
write (*, ‘(1x, a\)’) ‘Enter step size to be used (h): ’
x = x1
y = y1
i = 1
write (*, ‘(//1x, a//)’) “Solution points”
write (*, ‘(1x, 4x, i2, 5x, f6.3, 5x, f6.3)’) i, x, y
do while (x .lt. xf)
s1 = f(x,y)
x= x+h
s2 = f(x, y+h*s1)
y = y+h*(s1+s2)/2
i = i+1
write (*, ‘(1x, 4x, i2, 5x, f6.3, 5x, f6.3)’) i, x, y
enddo
end

OUTPUT:-

Program 21:
Program for Bisection Method to find the root of the equation
f(x) = x^4-x-10 = 0

C   program BisectionMethod
real x1, x2, x3, ep, f
f(x) = x**4-x-10
write (*,‘(1x,a\)’) ‘First point of search interval: ’
write (*,‘(1x,a\)’) ‘Second point of search interval: ’
write (*,’(1x,a\)’) ‘Enter permitted error: ’
do while (abs(x1-x2) .gt. ep)
x3 = (x1+x2)/2
if (f(x1)*f(x2) .lt. 0) then
x2 = x3
else
x1 = x3
endif
enddo
write (*,‘(1x,a,f8.4)’) ‘Approximate Root: ’,x3
end

OUTPUT :-

Program 22:
Program for False Position Method to find the root of the equation
f(x) = x^3-x-4 = 0

C   program FalsePositionMethod
real x1, x2, x3, ep, f
f(x) = x**3-x-4
write (*,‘(1x,a\)’) ‘First point of search interval: ’
write (*,‘(1x,a\)’) ‘Second point of search interval: ’
write (*,’(1x,a\)’) ‘Enter permitted error: ’
write (*,’(1x,a\)’) ‘Enter lower bound on slope: ’
f1 = f(x1)
f2 = f(x2)
do while (abs((x1-x2)/x2) .gt. ep)
if (fabs(f2-f1) .le. delta) then
print*, “Slope of the function becomes too small”
stop
endif
x3 = (x1*f2-x2*f1) / (f2-f1)
f3 = f(x3)
if (f1*f3 .lt. 0) then
x2 = x3
f2 = f3
else
x1 = x3
f1 = f3
endif
enddo
write (*,‘(1x,a,f8.4)’) ‘Approximate Root: ’,x3
end

OUTPUT :-

Program 23:
Program for Newton Raphson Method to find the root of the equation
f(x) = x^3-x-10 = 0

program NewtonRaphsonMethod
real x0, x1, ep, f, df, relerror, f0, df0
integer I,n
f(x) = x**3-x-10
write (*,‘(1x,a\)’) ‘Enter starting approximation: ’
write (*,’(1x,a\)’) ‘Enter permitted error: ’
write (*,’(1x,a\)’) ‘Enter lower bound on slope: ’
write (*,‘(1x,a\)’) ‘Enter maximum iterations permitted: ’
do i = 1, n
f0 = f(x0)
df0 = df(x0)
if (abs(df0) .le. delta) then
print*, “Slope of the function becomes too small”
stop
endif
x1 = x0–f0/df0
relerror = abs((x1-x0)/x1)
x0=x1
if (relerror .le. ep) then
write (*,10) i
10          format (//1x,‘Solution converges in ’, i2,‘iterations’)
write (*,‘(1x,a,f8.4)’) ‘Approximate Root: ’,x1
stop
endif
enddo
write (*,20) n
20  format (//1x,‘Solution does not converge in ’, i2,‘iterations’)
end

OUTPUT :-

Program 24:
Program to solve a first order differential equation using Runge-Kutta fourth order method

real s1, s2, s3, s4, x1, xf, y1, x, y, h, f
integer i
f(x,y) = x*y
write (*, ‘(1x, a\)’) ‘Starting solution point (x1,y1): ’
write (*, ‘(1x, a\)’) ‘Last point of the interval (xf): ’
write (*, ‘(1x, a\)’) ‘Enter step size to be used (h): ’
x = x1
y = y1
i = 1
write (*, ‘(//1x, a//)’) “Solution points”
write (*, ‘(1x, 4x, i2, 5x, f6.3, 5x, f6.3)’) i, x, y
do while (x .lt. xf)
s1 = f(x,y)
s2 = f(x+h/2, y+s1*h/2)
s3 = f(x+h/2, y+s2*h/2)
s4 = f(x+h, y+s3*h)
x= x+h
y = y+h*(s1+2*s2+2*s3+s4)/6
i = i+1
write (*, ‘(1x, 4x, i2, 5x, f6.3, 5x, f6.3)’) i, x, y
enddo
end

OUTPUT:-

Program 25:
Program to find the solution of a linear system of equations by Gauss Seidel method

real a [allocatable] (: , :), x [allocatable] (:)
real sum, temp, big, absoluteerror, ep
integer n, k, i, j, error, max
write (*, ‘(1x,a\)’) ‘Enter number of equations (n): ’
allocate (a(n, n+1), x(n), stat = error)
if (error .ne. 0) stop ‘Not enough memory’
write (*,*) ‘Enter elements row wise’
read (*,*) ((a(i,j), j = 1, n+1), i = 1, n)
write (*, ‘(1x,a\)’) ‘Enter permitted error: ’
write (*, ‘(1x,a\)’) ‘Enter maximum iterations permitted: ’
do i = 1, n
x (i) = 0.0
enddo
do k = 1, max
big = 0.0
do i = 1, n
sum = 0.0
do j = 1, n
if (1 .ne. j) sum = sum+a(i,j)*x(j)
enddo
temp = (a(i,n+1) – sum)/a(i,i)
absoluteerror = abs (x(i)-temp)
if (absoluteerror .gt. big) big = absoluteerror
x(i) = temp
enddo
if (big .le. ep) then
write (*,100) k
100         format (//1x, ‘Converges in’, i3, ‘iterations’)
write (*, ‘(1x, a//)’) ‘The computed solution is: ’
do i =1, n
write (*, ‘(1x, ‘x(‘, i2,’) = ‘, f7.3)’) i, x(i)
enddo
stop
endif
enddo
write (*,200) max
200 format (//1x, ‘Does not converge in ’, i3, ‘iterations’)
deallcoate (a, x, stat = error)
if (error .ne. 0) stop ‘Error in releasing memory’
end

Output: