QUS-01: Write a Fortran program to find the value of z, where z = x2-2xy+3y2-8x+3y-8 for

the values of x and y of range -3

Ans: PROGRAM VALUE
INTEGER J,K
REAL X,Y,Z
WRITE(6,11)
11 FORMAT(2X," X Y Z")
X=-3.0
DO J=1,31
Y=-3.0
DO K=1,31
Z=X**2-2.0*X*У+3.0*Y**2-8.0*X+3.0*Y-8.0
WRITE(6,20)X,Y,Z
Y=Y+0.2
ENDDO
X=X+0.2
ENDDO
20 FORMAT(2X,F12.5,2X, F12.5,2X,F12.5)
STOP
END

QUS-02: A function f(x) is defined by f(x) =(-x if x≤0 ; x if 0 <x < 1; 1-x if x≥1} Write a
Fortran Program segment to evaluate the above function
Ans: PROGRAM PIECEWISE
REAL X,F
PRINT*, "X"
READ(*,*)X
IF(X .LE. 0.0) F = -X
IF((X .GT. 0.0).AND.(X LT. 1.0)) F = X
IF(X .GE. 1.0) F = 1.0-X
WRITE(, *"X F(X)")
WRITE(, *)X,F
END PROGRAM

QUS-03: A function is defined as follows : f(x)={1-x**2,x<0 ;1+2x,0≤x<1 3+1/x,X>1 }If x (-

10, 10] then find the velue of f(x) by using fortran for each x= 0.5
Ans: PROGRAM PIECEWISE
REAL X,FX
 PRINT*,"X"
X=-10.0
15 IF(X.LT.O.0)THEN
FX=1.0-X**2
ENDIF
IF(X.GE.0.0).AND.(X.LT.1.0))THEN
FX=1.0+2.0*X
ENDIF
IF(X.GT.1.0)THEN
FX=3.0+1.0 / X
ENDIF
WRITE(6,20)X, FX
X=X+0.5
IF(X.LE. 10.0)GOTO 15
20 FORMAT(3X,2F10.3)
END PROGRAM

QUS-04: Consider f(x,y)={ xy(x2 - y2)/x2+y2, When (x, y) = (0, 0) 0,When (x, y) = (0, 0)
;Write a FORTRAN program which find fxy (0, 0) and fxy (0, 0) and print fxy (0, 0) = fxy(0,
0)
Ans: PROGRAM piecewise
REAL H,X
PARAMETER(H=0.00001,K=0.00001) F(X,Y)=(X*У*(X**2-Y**2))/(X**2+Y**2)
FO=0.0
Y=K
FX=(F(H,Y)-F(0,Y))/H
FXY=(FX-FO)/ K
WRITE(,)
PRINT*," FXY = ",FXY
X=H
FY=(F(X,K)-F(X,0))/K
FYX=(FY-FO)/H
WRITE(*,*)
PRINT*," PYX =",PYX
WRITE(,)
IF(FXY.NE.FYX)PRINT*,"FXY"
END PROGRAM
QUS-5: Solve the following system correct to five decimal places
2x+4y+6z=22,3x+8y+5z=27,-x+y+2z=2 by using SOR iterative method with three
different of omega.
Ans: program SOR_Method
implicit none
integer, parameter :: n = 3
real(8), dimension(n, n) :: A
real(8), dimension(n) :: b, x, x_new
real(8) :: omega
real(8) :: tol
integer :: i, j, iter, max_iter
real(8) :: residual vector b
A = reshape([2.0d0, 4.0d0, 6.0d0, &
3.0d0, 8.0d0, 5.0d0, &
-1.0d0, 1.0d0, 2.0d0], [n, n])
b = [22.0d0, 27.0d0, 2.0d00
x = [0.0d0, 0.0d0, 0.0d0]
max_iter = 10000
tol = 1.0e-1
write(*,*) "Enter the value of omega:"
read(*,*) omega
do iter = 1, max_iter
x_new = x
do i = 1, n
x_new(i) = (1.0d0 - omega) * x(i) + omega * (b(i) - dot_product(A(i, 1:i-1), x_new(1:i-1)) -
&
dot_product(A(i, i+1:n), x(i+1:n))) / A(i, i)
end do
residual = maxval(abs(b - matmul(A, x_new)))
if (residual < tol) then
exit
end if
x = x_new
end do
write(*,*) "Solution:" do i = 1, n
write(*,*) "x(", i, ") =", x(i)
end do
if (residual >= tol) then
write(*,*) "Convergence not achieved within ", max_iter,
" iterations."
else
write(*,*) "Convergence achieved in ", iter, " iterations."
end if
end program SOR_Method

QUS-6: Compute by simpson's 1/3 and Simpson's 3/8 rule and compare your result with the
exact value.
Ans: PROGRAM SIMPSONS
INTEGER N,K
F(X)=SQRT(1.0-X**2)
X0=0.0
XN=1.0
N=24
H=(XN-X0)/FLOAT(N)
S1=(F(X0)+F(XN))
S2=(F(X0)+F(XN))
DO K=1,N-1
X1=X0+FLOAT(K)*H
F1=F(X1)
IF(MOD(K,2).EQ.0)THEN
S1=S1+2.0*F1
ELSE
S1=S1+4.0*F1
ENDIF
IF(MOD(K,3).EQ.0)THEN
S2=S2+2.0*F1
ELSE
S2=S2+3.0*F1
ENDIF
ENDDO
S13=S1*(H/3.0)
S38=S2*(3.0*H/8.0)
PRINT*,"SIMPSONS 1/3 AND SIMPSONS 3/8"
PRINT*,S13,S38
END PROGRAM
QUS-7: For Romberg integration to approximate the value of the integral correct upto five
decimal places.Compare your result with the exact vlaue 0.0887553.Show your result in a
tabular form
Ans: program romberg_integration
implicit none
integer, parameter :: max_levels = 20
real(8), parameter :: pi = 3.14159265358979323846
real(8) :: a, b, h, integral
real(8), dimension(max_levels, max_levels) :: romberg_table
integer :: n, i, j a = 0.0 b = pi / 4.0
romberg_table = 0.0 h=b–a
integral = h * (0.5d0 * (a**2 * sin(a) + b**2 * sin(b)) + sum_x2sin(a, b, h))
integral = h * (0.5d0 * (a**2 * sin(a) + b**2 * sin(b)) + sum_x2sin(a, b, h))
romberg_table(1, 1) = integral
do n = 2, max_levels
h = h / 2.0d0
integral = 0.5d0 * integral + h * sum_x2sin(a, b, h)
romberg_table(1:n, n) = integral
do i = 2, n
j=n-i+2
romberg_table(i, j) = (4.0d0**(i-1) * romberg_table(i-1, j+1) - romberg_table(i-1, j)) / (4.0d0**(i-1) -
1.0d0)
end do
! Check for convergence
if (abs(romberg_table(1, 1) - romberg_table(i, j)) < 1.0d-6) then
exit
end if
end do
write(*, *) "Approximate Integral Value:", romberg_table(1, 1) contains
recursive function sum_x2sin(a, b, h) result(result)
real(8), intent(in) :: a, b, h
real(8) :: result
real(8) :: x
result = 0.0
do x = a + h, b - h, h
result = result + x**2 * sin(x)
end do
 end function sum_x2sin
end program romberg_integration

QUS-8: Write a Fortran program, which prints the first 20 Fibonacci numbers and
determine whether each number is prime or not. find prime number or not from Fibonacci
numbers
Ans: PROGRAM PRIME
PARAMETER(N=20)
DIMENSION F(N)
INTEGER F
F(1)=1
F(2)=1
DO K=3,N
F(K)=F(K-1)+F(K-2)
END DO
DO 20 M=1,N
IF(F(M).LT.2)GOTO 10
J=M/2
DO I=2,J
IF(MOD(F(M),I).EQ.0)GOTO 10
END DO
PRINT*,F(M),"IS A PRIME"
GOTO 20
10 PRINT*,F(M),"IS NOT A PRIME"
20 CONTINUE
END PROGRAM

QUS-9: Write a Fortran program to find the product AB=C where A and B are defined as
A=/1,2,3,3,5,8,5,7,1/ and B=/3,2,13,2,3,8,15,7,10/
Ans: PROGRAM PRODUCT
PARAMETER(N=3)
INTEGER A,B,C
DIMENSION A(N,N),B(N,N),C(N,N)
DATA A/1,2,3,3,5,8,5,7,1/
DATA B/3,2,13,2,3,8,15,7,10/
WRITE(6,*)"MATRIX A="
WRITE(6,10)((A(I,J),J=1,N),I=1,N)
WRITE(6,*)"MATRIX B="
 WRITE(6,10)((B(I,J),J=1,N),I=1,N)
10 FORMAT(1X,3(I4,2X))
CALL PROD(N,A,B,C)
WRITE(6,*)"MATRIX C=AB"
WRITE(6,10)((C(I,J),J=1,N),I=1,N)
END PROGRAM
SUBROUTINE PROD(N,A,B,C)
DIMENSION A(N,N) ,B(N,N),C(N,N)
INTEGER A,B,C
DO I=1,N
DO J=1,N
C(I,J)=0
DO K=1,N
C(I,J)=C(I,J)+A(I,K)*B(K,J)
END DO
END DO
END DO
RETURN
END

QUS-10: Use LU decomposition method to solve the system of linear equations AX=B
where A=/4,2,1,1,7,-3,-1,1,12/ ,X=/a,b,c/ and b=/3,19,31/.Show the results of L,U and
solutions.
Ans: program lu_decomposition
implicit none
integer, parameter :: n = 3
real(8) :: A(n,n), L(n,n), U(n,n), B(n), X(n)

integer :: i, j, k

data A /1.0, 2.0, 3.0, 3.0, 5.0, 8.0, 5.0, 7.0, 2.0/
data B /3.0, 19.0, 31.0/
do i = 1, n
U(i,i) = A(i,i)
do j = i+1, n
U(i,j) = A(i,j)
L(j,i) = A(j,i) / U(i,i)
end do
do j = i+1, n
do k = i+1, n
A(j,k) = A(j,k) - L(j,i) * U(i,k)
end do
end do
end do
X(1) = B(1) / L(1,1)
do i = 2, n
X(i) = B(i)
do j = 1, i-1
X(i) = X(i) - L(i,j) * X(j)
end do
X(i) = X(i) / L(i,i)
end do
X(n) = X(n) / U(n,n)
do i = n-1, 1, -1
X(i) = X(i)
do j = i+1, n
X(i) = X(i) - U(i,j) * X(j)
end do
X(i) = X(i) / U(i,i)
end do
write(*, *) "L matrix:"
do i = 1, n
write(*, "(3F8.4)", advance="no") (L(i,j), j=1,n)
write(*, *)
end do
write(*, *) "U matrix:"
do i = 1, n
write(*, "(3F8.4)", advance="no") (U(i,j), j=1,n)
write(*, *)
end do
write(*, *) "Solution X:"
write(*, "(3F8.4)") (X(i), i=1,n)
end program lu_decomposition
QUS-11: (i) (1+1/2)+(1+1/2+1/3)+…….+(1+1/2+1/3+….+1/100)
(ii) 1+1/2!+ 1/3!+…..+1/25!; where n€N
Ans:
(i)
PROGRAM SUMMATION
SUM=0.0
DO 15 I=1,100
DO J=1,I
SUM=SUM+1.0/REAL(J)
END DO
15 CONTINUE
WRITE(6,20) SUM
20 FORMAT(3X,"SUM=", F12.5)
STOP
END PROGRAM
(ii)
program summation
integer sum,fact
sum=0.0
do k=1,25
sum=sum+fact(k)
end do
write(6,20) sum 20
format(3x,"sum=",i20)
end program

QUS-12: Write a FORTRAN program to find it output, to obtain the root of the equation
cosx=3x-1 correct to four decimal places, using fixed point iteration method.
Ans: program fixedpoint
implicit none
integer :: N
real*8 :: x_old,x_new,f,epsilon
epsilon=0.1
write(*,*) "Enter initial guess:"
read(*,*) x_old
do N=1,100
f=cos(x_old)-3.0*x_old+1.0
x_new=x_old+epsilon*f
write(*,'(i4,f12.6)') N, Abs(x_new-x_old)
if(Abs(x_new-x_old)<0.0001) then
write(*,'(/a,f12.7,a,f12.9)')'Root is x=',x_new,',funtion value
f=',f
stop
end if
x_old=x_new
end do
write(*,'(a)')'No convergence'
stop
end program

QUS-13: Write a FORTRAN program for bisection method to find a root of the equation
Ans: PROGRAM BISECTION
F(X)=EXP(-X)-X tol=0.0001
PRINT*,"Enter XO and XN"
10 READ(5,*) XO,XN
20 IF(F(XO)*F(XN).LT.0) THEN c=(XO+XN)/2.0
ELSE
WRITE(6,*) "Change for another XO & XN"
GOTO 10
END IF
IF(F(XO)*F(c).LT.0) THEN
XN=c
ELSE
XO=c
END IF
IF(ABS(XN-XO).GT.tol) GOTO 20
WRITE(*,*) "the root is=",c
 END PROGRAM

QUS-14: Write a FORTRAN program to find the largest Eigen value of the matrix
Ans: PROGRAM POWER
DIMENSION A(3,3),V(3,1),C(3,1)
DATA A/5,0,1,0,-2,0,1,0,5/
DATA V/1,0,0/
PRINT*," MATRIX A"
X(0)=(85.0-6.0*Y(0)+Z(0))/27.0
M=0
PRINT*," X Y Z"
PRINT 5,M,X(M),Y(M),Z(M)
5 FORMAT(3X,I5,3F15.6/)
DO N=1,K
X(N)=(85.0-6.0*Y(N-1)+Z(N-1))/27.0
Y(N)=(72.0-6.0*X(N)+2.0*Z(N-1))/15.0
Z(N)=(110.0-X(N)-Y(N))/54.0
PRINT 10,N,X(N),Y(N),Z(N)
10 FORMAT(3X,I5,3F15.6/)
END DO
PRINT*,"APPROXIMATE SOLUTIONS"
PRINT*,"X=",X(K)
PRINT*,"Y=",Y(K)
PRINT*,"Z=",Z(K)
END PROGRAM

QUS-15: Use Newtons Forward difference interpolation formula to evalute F(2003) for the
following set of tabulated values. data X/2000,2005,2010,2015,2020,2025/ and
Y=f(x)/100,125,139,200,250/
Ans: program NewtonForwardInterpolation
implicit none
integer, parameter :: n = 5
real :: x(n), y(n), F, x_interp
real :: coefficients(n)
integer :: i, j
real(8) :: term
data x /2000.0, 2005.0, 2010.0, 2015.0, 2020.0/
data y /100.0, 125.0, 139.0, 200.0, 250.0/
x_interp = 2003.0 coefficients = y do i = 2, n
do j = n, i, -1
coefficients(j) = (coefficients(j) - coefficients(j - 1)) / (x(j) - x(j
- i + 1))
end do
end do
F = coefficients(1) do i = 2, n
term = coefficients(i) do j =
1, i - 1
term = term * (x_interp - x(j))
end do
F = F + term
end do
write(*,*) "F(2003) =", F
end program NewtonForwardInterpolation

QUS-16: Write a Fortran program to find the complex root of the equation 2x**+x+1=0.
Program to find the real and complex roots.
Ans: IMPLICIT DOUBLE PRECISION(A-H,O-Z)
WRITE(*,*)"ENTER A,B,C OF EQ A*X**2+B*X+C=0"
READ(*,*)A,B,C
D=B**2-4*A*C
IF(D.GT.0)THEN
ROOT1=(-B/(2*A))+(SQRT(D))/(2*A)
ROOT2=(-B/(2*A))-(SQRT(D))/(2*A) WRITE(*,*)ROOT1,ROO2
ELSEIF(D.EQ.0)THEN
ROOT1=(-B/(2*A))
ROOT2=ROOT1
WRITE(*,*)ROOT1,ROOT2
ELSE
ROOT1=(-B/(2*A))+(SQRT(-D))/(2*A)
ROOT2=(-B/(2*A))-(SQRT(-D))/(2*A)
A1=(ROOT1+ROOT2)/2
B1=(ROOT1-ROOT2)/2
WRITE(*,*)"REAL PART=",A1,"COMPLEX PART=",B1
END IF
 STOP
END

QUS-17: Write a FORTRAN program which reads a 5*5 matrix and find its inverse
matrix.
Ans: PARAMETER(I=5,J=5)
DIMENSION A(3,6), B(3,3)
DATA B/A(5,6), B(5,5)/
PRINT*, " MATRIX A"
WRITE(6,*)
PRINT 20,((B(I,J),J=1,3),I=1,3)
20 FORMAT(3X, 3F8.2//)
DO 18 I=1,3
DO J=1,6
IF(J.LE.3) THEN
A(I,J)=B(I,J)
ELSE
IF(J.EQ.I+3) THEN
A(I,J)=1.0
ELSE
A(I,J)=0.0
END IF
END IF
END DO
END DO
18 CONTINUE
PRINT*, " AUGMENTED MATRIX"
WRITE(6,*)
PRINT 10, ((A(I,J), J=1,6), I=1,3)
FORMAT(3X,6F8.2//)
DO 7 I=1,3
IF(A(I,I).NE. 0.0)THEN
P=A(I,I)
ELSE
PRINT*, "PIVOT ELEMENT IS ZERO"
STOP
END IF
END DO
 DO JJ=1,6
A(I,JJ)=A(I,JJ)/P
END DO
DO 3 J=1,3
IF(J.EQ.I) GOTO 3
COM=A(J,I)
DO K=1,6
A(J,K)=A(J,K)-A(I,K)*COM
END DO
END DO
3 CONTINUE
7 CONTINUE
WRITE(6,*)
PRINT*, " AUGMENTED ECHELON MATRIX"
WRITE(6,*)
PRINT 11, ((A(I,J),J=1,6), I=1,3)
11 FORMAT(3X, 6F8.2//)
DO 25 I=1,3
DO J=4,6
K=J-3
B(I,K)=A(I,J)
END DO
END DO
25 CONTINUE
WRITE(6,*)
PRINT*, " INVERSE OF MATRIX A"
WRITE(6,*)
PRINT 30, ((AI(I,J), J=1,3),I=1,3)
30 FORMAT(3X, 3F8.2//)
STOP
END

QUS-18: Write a FORTRAN program to evaluate by using Simpson”s three eight rules .
Ans: PROGRAM SIMP38
INTEGER:: N,K
REAL::H,F1,S
F(X)=1.0/(1.0+X**2)
XO=0.0
 XN=6.0
N=12
H=(XN-XO)/FLOAT(N)
S=(F(XO)+F(XN))
DO K=1,N-1
X1=XO+FLOAT(K)*H
F1=F(X1)
IF(MOD(K,3).EQ.0) then S=S+2.0*F1
else
S=S+3.0*F1
END IF
END DO
S38=S*(3.0*H/8.0)
WRITE(6,11) S38
11 FORMAT(3X,"THE INTEGRAL VALUE IS=", F10.7)
END PROGRAM

QUS-19: Write a FORTRAN program for Trapezoidal rule to evaluate the integral
Ans: PROGRAM TRAPEZOIDAL
REAL::A,B
INTEGER::N
F(X)=1.0/(1.0+X**2)
READ(*,*) A,B,N
H=(B-A)/FLOAT(N)
S=F(A)+F(B)
DO I=1,N-1
S=S+2.0*F(A+FLOAT(I)*H)
END DO
TRAP=S*H/2.0
WRITE(*,*)"The integral value is=", TRAP
END PROGRAM

QUS-20: Write a FORTRAN program to find the product of AB, where A and B are
matrices of order l*m and m*n respectively.
Ans: PROGRAM PRODUCT
PARAMETER(L=2,M=3,P=3,N=3)
INTEGER A,B,C
DIMENSION A(L,M),B(M,N),C(L,N)
OPEN(UNIT=3,FILE="INP1.TXT")
OPEN(UNIT=4,FILE="OUT1.TXT")
IF(M.NE.P) THEN
PRINT*,"matrices are not multiplicative"
STOP
END IF
READ(3,*)((A(I,J),J=1,M),I=1,L)
READ(3,*)((B(I,J),J=1,N),I=1,M)
WRITE(4,*)"Matrix A="
WRITE(4,10)((A(I,J),J=1,M),I=1,L)
WRITE(4,*)"Matrix B="
WRITE(4,10)((B(I,J),J=1,N),I=1,M)
10 FORMAT(1X,3(I4,2X))
CALL PROD(L,M,N,A,B,C)
WRITE(4,*)"Matrix C=AB"
WRITE(4,10)((C(I,J),J=1,N),I=1,L)
END PROGRAM
SUBROUTINE PROD(L,M,N,A,B,C)
DIMENSION A(L,M),B(M,N),C(L,N)
INTEGER A,B,C
DO I=1,L
DO J=1,N
C(I,J)=0
DO K=1,M
C(I,J)=C(I,J)+A(I,K)*B(K,J)
END DO
END DO
END DO
RETURN
END SUBROUTINE

QUS-21: Using lagranges interpolation formula of 2-points, 3points and 4-points, write a
program to estimate f6.0) employing the following data sets.
Ans: PROGRAM LAGRANGE
REAL X(0:3), F(0:3)
 DATA X/ 1.0,4.0,9.0, 16.0/
DATA F/101.0,102.0,103.0,104.0/
DO K=2,4
Y=6.0
S=0.0
DO I=0,K-1
P=1.0
DO 10 J=0,K-1
IF(I.EQ.J)GOTO 10
P=P*(Y-X(J))/ (X(I)-X(J))
10 CONTINUE
S=S+P*F(I)
ENDDO
WRITE(6,20)K
20 FORMAT(3X, "FOR", I3,"-POINT FORMULA")
WRITE(6,30)Y,S
30 FORMAT(3X,"×=",F6.1,3X," (x)=", F10.4)
ENDDO
END PROGRAM

QUS-22: A class of 20 students takes the four test on imputer course. Write a Fortran
program which finds (i) The average score,(ii) The no. of first class scores ( i. e. score ≥
60%),(iii) The no. of second class scores (i.e. 45% ≤ score < 60%)(iv) The no. of third class
scores (i.e. 40% ≤ score < 45%),(v) The no, of those which failed.
Ans: PARAMETER(N=20)
INTEGER S(N), M(N, 4)
CHARACTER*15 A(N)
OPEN(UNIT=4, FILE-SCORE.IN)
READ(4,*)(M(1, J), J=1, 4), 1=1, N))
DO 15 I=1, N
S(I)=0
DO J=1,4
S(I)=S(1)+M(I, J)
ENDDO
15 CONTINUE
DO 10 I=1, N
DO J=1, 4
IF(M(,J).LT.40).OR.(S(1). LT. 160)THEN
 A(1)='FAIL'
GOTO 10
ELSEIF(S(1) GE. 160).AND.(S(1). LT. 180) THEN
A(I)='3RD CLASS'
ELSEIF(S(1). GE. 180).AND. (S(1).LT.240))THEN
A(I)= '2ND CLASS'
ELSE
A(])= '1ST CLASS'
ENDIF
ENDDO
10 CONTINUE
DO 1=1, N
WRITE(6, 20)I, (M(I, J), J=1, 4), S(1), A(I)
ENDDO
20 FORMAT(3X, 616 ,5X, A15/)
STOP
END

QUS-23: A class of 20 students takes the four test on imputer course. Write a Fortran
program which finds (i) The average score,(ii) The no. of first class scores ( i. e. score ≥
60%),(iii) The no. of second class scores (i.e. 45% ≤ score < 60%)(iv) The no. of third class
scores (i.e. 40% ≤ score < 45%),(v) The no, of those which failed.
Ans: PARAMETER(N=20)
INTEGER S(N), M(N, 4)
CHARACTER*15 A(N)
OPEN(UNIT=4, FILE-SCORE.IN)
READ(4,*)(M(1, J), J=1, 4), 1=1, N))
DO 15 I=1, N
S(I)=0
DO J=1,4
S(I)=S(1)+M(I, J)
ENDDO
15 CONTINUE
DO 10 I=1, N
DO J=1, 4
IF(M(,J).LT.40).OR.(S(1). LT. 160)THEN
A(1)='FAIL'
GOTO 10
ELSEIF(S(1) GE. 160).AND.(S(1). LT. 180) THEN
A(I)='3RD CLASS'
ELSEIF(S(1). GE. 180).AND. (S(1).LT.240))THEN
A(I)= '2ND CLASS'
ELSE
A(])= '1ST CLASS'
ENDIF
ENDDO
10 CONTINUE
DO 1=1, N
WRITE(6, 20)I, (M(I, J), J=1, 4), S(1), A(I)
ENDDO
20 FORMAT(3X, 616 ,5X, A15/)
STOP
END

QUS-24: Wirte a Fortran program to compute y(0.2) by RungeKutta method of order for
the differential equation: dy/dx=( ху + у2, y(0) = 1.
Ans: PROGRAM RK4 integer iter

iter = 0
write(*,*)'Enter initial values x0, yO and expected function with at xl:' read(*,*)x0, yO, xl
write(*,*)'Enter the number of subintervals:' read(*,*)n h =(x1-x0)/real(n)
write(*,30)
30 format(8x,' x ',5x,' f(x) ') write(*,40)x0,y0
40 format(1x, F10.4,F10.4)
50 s1 = f(×0,0) s2 = f(x0+h/2.,y0+s1*h/2.) s3 =
f(x0+h/2.,y0+s2*h/2.) s4 = f(x0+h,y0+s3*h) yl =
y0+(s1+2.*s2+2.*s3+s4)*h/6.0 xl = x0+h write(*,40) x1, y1 iter =
iter+ 1

IF(iter.LT.n)THEN X0 = xl y0 = yl
GOTO 50 ENDIF write(*,60) xl, y1
60 format(1x, The value at ',P10.4,' is :,P10.4)
STOP
END
!•====Given function===================
function f(x,y) f= x*yy**2 return
END

QUS-25: Write a Fortran program to solve the cox - xe = O using Newton-Raphson method.
Ans: PROGRAM NEWTONS
F(X)=COS(X)-X*EXP(X)
FD(X)= SIN(X)-EXP(X)-X*EXP(X)
Tol = 0.00001
PRINT*,'Enter x0*
10 READ(5,*)XO
N=1
PRINT*,' N X'
20 A=F(XO)
IF(A.EQ.O.O)GOTO 40
B=FD(X0)
IF(B.EQ.0.0)GOTO 10
WRITE(6,30)N,XO
30 FORMAT(3X, 13, 2X, F10.4)
X1=X0- A/B
IF(ABS(X0-XI).LT.Tol) GOTO 40
N=N+1
X0=X1
GOTO 20
40 WRITE(6,50)XO
50 FORMAT(3X, THE SOLUTION X = ', P10.4)
END PROGRAM

QUS-26: Write a Fortran program to minimize the objective function Maz[15x+18y].

S.t 5x+3y>=2,3x+6y>=3, x,y>=0
Ans: program LinearProgramming
implicit none
integer, parameter :: n = 2 ! Number of variables
integer, parameter :: m = 2 ! Number of constraints
real :: A(m, n) ! Coefficient matrix
real :: c(n) ! Objective function coefficients
real :: b(m) ! Right-hand side of constraints
real :: x(n) ! Solution vector
real :: z
 real :: ratio ! Objective function value

integer :: i, j
real :: pivot_col, pivot_row, pivot_element

! Initialize the coefficient matrix A

A(1, 1) = 5.0
A(1, 2) = 3.0
A(2, 1) = 3.0
A(2, 2) = 6.0
! Initialize the objective function coefficients
c(1) = -15.0
c(2) = -18.0

! Initialize the right-hand side of constraints

b(1) = 2.0
b(2) = 3.0

! Initialize the solution vector

x(1) = 0.0
x(2) = 0.0

! Main Simplex loop

do
! Find the entering variable (pivot column)
pivot_col = 0.0
do j = 1, n
if (c(j) < pivot_col) then
pivot_col = c(j)
pivot_element = j
end if
end do
! Check for optimality
if (pivot_col >= 0.0) then
! Optimal solution found
 exit
end if
! Find the leaving variable (pivot row)
pivot_row = huge(0.0)
do i = 1, m
if (A(i, pivot_element) > 0.0) then

ratio = b(i) / A(i, pivot_element)

if (ratio < pivot_row) then

pivot_row = ratio

pivot_element = i

end if

end if

end do

! Update the solution vector and coefficients

x(pivot_element) = pivot_row
do j = 1, n
c(j) = c(j) + pivot_row * A(pivot_element, j)
end do
do i = 1, m
if (i /= pivot_element) then do j = 1, n
A(i, j) = A(i, j) - A(i, pivot_element) * A(pivot_element, j)
end do
b(i) = b(i) - A(i, pivot_element) * b(pivot_element)
end if
end do
end do

! Calculate the objective function value z = 0.0 do j = 1, n

z = z + c(j) * x(j)
end do
! Print the solution
print *, "Solution:"
print *, "x =", x(1)
print *, "y =", x(2)
print *, "Objective function value:", z
end program LinearProgramming

QUS-27: Write Fortran program to solve the system of equations using gauss-seidel method.
27x + 6y + z = 85,6x + 15y + 2z= 72,x + y + 54z= 110
Ans: PROGRAM GaussSeidel
PARAMETER(K=20)
DIMENSION X(O:K), Y(O:K), Z(0:K)
Y(0) =0.0
Z(0)=0.0
X(0)=(85.0-6.0*Y(0)+Z(0)) /27.0
M=0
PRINT*,"X Y Z"
PRINT 5, M, X(M), Y(M), Z(M)
FORMAT(3X, 15, 3F15.6 /)
DO N=1,K
X(N)=(85.0-6.0*Y(N-1)+Z(N-1))/27.0
Y(N)=(72.0-6.0*X(N)+2.0*Z(N-1))/ 15.0
Z(N)=(110.0-X(N)-Y(N))/54.0 |
PRINT 10, N, X(N), Y(N) , Z(N)
10 FORMAT(3X, 15, 3F15.6 /)
ENDDO
PRINT*," APPROXIMATE SOLUTIONS"
PRINT*, "X = ", X(K)
PRINT*, "Y =", Y(K)
PRINT*, "Z=", Z(K)
END PROGRAM

QUS-28: Write a Fortran program to solve the following system of equations by using Gauss
elimination method correct upto five decimal places.
 x+y-z=2,2X+3y+5Z=-3,3x+2y+3z=6
Gauss-Elimination to solve a system of linear equations.
Ans: PROGRAM GaussElimi
PARAMETER(N=3)
DIMENSION A(N,N),B(N),X(N)
DATA A/1,2,3,1,3,2,-1,5,3/
DATA B/2,-3,6/
PRINT 20,((A(I,J),J=1,3),B(I),I=1,3)
20 FORMAT(3X,3F8.3,3X,F8.3)
DO K=1,N-1
P=A(K,K)
DO I=K+1,N
F=A(I,K)/P
DO J=K+1,N
A(I,J)=A(I,J)-F*A(K,J)
END DO
B(I)=B(I)-F*A(K,J)
END DO
END DO
PRINT 20,((A(I,J),J=1,3),B(I),I=1,3)
X(N)=B(N)/A(N,N)
DO K=N-1,1,-1
SUM=0.0
DO J=K+1,N
SUM=SUM+A(K,J)*X(J)
END DO
X(K)=(B(K)-SUM)/A(K,K)
END DO
WRITE(6,*)"SOLUTIONS"
PRINT*,'X=',X(1)
PRINT*,'Y=',X(2)
PRINT*,'Z=',X(3)
END PROGRAM

QUS-29: Consider the differential equation dy/dx=x**2+1;y(0)=0.5.Write a Fortran

program to find the solution of the equation for x=0 to x=2 by Euler and Modified Euler
method.
Ans: IMPLICIT NONE
INTEGER N
PARAMETER (N=10)
REAL W(0:N),A,B
WRITE(*,*)'ENTER THE BOUNDARY POINT A,B AND INITIAL VALUE Y0=W0'
READ(*,*)A,B,W(0)
WRITE(*,*)'MODIFIED EULER METHOD'
CALL EULER(A,B,W,N)
WRITE(*,*)'MODIFIED EULER METHOD'
CALL MEULER(A,B,W,N) STOP end
SUBROUTINE EULER(A,B,W,N)
REAL W(0:N)
H=(B-A)/N
X=A
WRITE(*,22),X,W(I)
DO I=1,N
W(I)=W(I-1)+H*F(X,W(I-1))
X=A+I*H
WRITE(*,22),X,W(I)
22 FORMAT(3X,F5.3,2X,F10.6)
END DO
RETURN
END
SUBROUTINE MEULER(A,B,W,N)
REAL W(0:N),TOL
TOL=0.00001
H=(B-A)/N
X=A
WRITE(*,33),X,W(I)
DO I=1,N
G=W(I-1)+H*F(X,W(I-1))
10 W(I)=W(I-1)+(H/2)*(F(X,W(I-1))+F(X+H,G))
IF(ABS(W(I)-G).GT.TOL)THEN
G=W(I)
 GOTO 10
ENDIF
X=A+I*H
WRITE(*,33),X,W(I)
33 FORMAT(3X,F5.3,2X,F10.6)
ENDDO
RETURN
END
FUNCTION F(X,Y)
F=X*X+1
RETURN
END