1.

Leap Year

PROGRAM LEAP

IMPLICIT NONE

INTEGER::A,B,C,D

PRINT*,"ENTER YEAR"

READ*,A

B=MOD(A,400)

C=MOD(A,4)

D=MOD(A,100)

IF(D==0)THEN

ELSEIF(B==0)THEN

PRINT*,"LEAP YEAR"

ELSE

PRINT*,"NON LEAP YEAR"

ENDIF

END PROGRAM LEAP_YEAR

1
2. Greatest of three integer

PROGRAM GREATEST_OF_3_NUMBERS

IMPLICIT NONE

INTEGER::A,B,C

PRINT*,"ENTER A"

READ*,A

PRINT*,"ENTER B"

READ*,B

PRINT*,"ENTER C"

READ*,C

IF(A>B)THEN

ELSEIF(A>C)THEN

PRINT*,"A IS GREATEST"

ELSEIF(C>A)THEN

PRINT*,"C IS GREATEST"

ELSEIF(B>C)THEN

PRINT*,"B IS GREATEST"

ELSE

PRINT*,"C IS GREATEST"

ENDIF

ENDPROGRAM GREATEST_OF_3_NUMBERS

2
3. Student grade (Using IF-Else)

PROGRAM STUDENT_GRADE

IMPLICIT NONE

INTEGER::X,Y

PRINT*,"ENTER THE MARKS"

READ*,X

PRINT*,"ENTER THE ROLL NO"

READ*,Y

IF(X>=70)THEN

PRINT*,"A GRADE"

ELSEIF(60<=X)THEN

PRINT*,"B GRADE"

ELSEIF(50<=X)THEN

PRINT*,"C GRADE"

ELSEIF(40<=X)THEN

PRINT*,"D GRADE"

ELSE

PRINT*,"FAIL"

ENDIF

PRINT*,"ROLL NO=",Y,"MARKS=",X

ENDPROGRAM STUDENT_GRADE

3
4. Sum of number

PROGRAM sum_of_number

IMPLICIT NONE

INTEGER::digit,number,n,sum

sum=0

PRINT*,"TYPE AN INTEGER"

READ*,number

print*,"NUMBER= ",number

n=number

DO

IF(n==0)EXIT

digit=MOD(n,10)

sum=sum+digit

n=n/10

END DO

PRINT*,"NUMBER=",number,"SUM=",sum

END PROGRAM sum_of_number

4
5. Reverse of number

PROGRAM FUNCTION

IMPLICIT NONE

INTEGER::digit,number,n

n=0

PRINT*,"Type a number"

READ*,number

Print*,"Number=",number

DO

IF(number==0)EXIT

n=n*10

digit=MOD(number,10)

n=n+digit

number=number/10

ENDDO

PRINT*,"Number=",number,"Reverse=",n

ENDPROGRAM FUNCTION

5
6. Polynomial

PROGRAM POLY

IMPLICIT NONE

INTEGER::i,n

REAL::x,polynomial

REAL,DIMENSION(0:20)::a

PRINT*,"TYPE ORDER OF POLYNOMIAL n and x"

READ*,n,x

PRINT*,"TYPE COMPONENTS OF a"

READ*,(a(i),i=0,n)

polynomial=a(n)

DO i=n,1,-1

polynomial=a(i-1)+x*polynomial

END DO

PRINT*,"x=",x,"polynomial= ",polynomial

END PROGRAM POLY

6
7. Addition and subtraction of matrix

PROGRAM MATRIX

IMPLICIT NONE

INTEGER,DIMENSION(100,100)::MATA,MATB,MATC,MATD

INTEGER::I,J,X,Y

PRINT*,"ENTER THE ORDER OF MATRIX"

READ*,X,Y

PRINT*,"ENTER THE VALUE OF ELEMENT OF MATRIX A"

READ*,((MATA(I,J),I=1,X),J=1,Y)

PRINT*,"ENTER THE VALUE OF ELEMENT OF MATRIX B"

READ*,((MATB(I,J),I=1,X),J=1,Y)

DO J=1,Y

DO I=1,X

MATC(I,J)=MATA(I,J)+MATB(I,J)

MATD(I,J)=MATA(I,J)-MATB(I,J)

END DO

END DO

PRINT*,"ADDITION=",((MATC(I,J),I=1,X),J=1,Y)

PRINT*,"SUBTRACTION=",((MATD(I,J),I=1,X),J=1,Y)

END PROGRAM MATRIX

7
8. Transpose of matrix

PROGRAM TRANSPOSE_OF_MATRIX

IMPLICIT NONE

INTEGER,DIMENSION(100,100)::matrix,matrix1

INTEGER::i,j,x,y

PRINT*,"ENTER THE ORDER OF THE MATRIX"

READ*,x,y

PRINT*,"ENTER THE ELEMENTS OF THE MATRIX"

READ*,((matrix(i,j),i=1,x),j=1,y)

DO j=1,y

DO i=1,x

matrix1(i,j)=matrix(j,i)

END DO

END DO

PRINT*,((matrix1(i,j),i=1,x),j=1,y)

END PROGRAM TRANSPOSE_OF_MATRIX

8
9. Student grade (by loop)

PROGRAM student_grade
IMPLICIT NONE
INTEGER,DIMENSION(3,5)::s
INTEGER::i,j,sum
sum=0
print*,"ENTER THE MARKS OF 5 STUDENT IN THREE SUBJECTS 1,2,3"
READ*,((s(i,j),i=1,3),j=1,5)
DO j=1,5
sum=0
DO i=1,3
IF(s(i,j)<35)THEN
PRINT*,"STUDENT NO = ",j,"FAILED IN THE SUBJECT= ",i
END IF
sum=sum+s(i,j)
END DO
IF(sum>=250)THEN
PRINT*,"student no = ",j,"has obtained A GRADE"
ELSE IF(sum>=200)THEN
PRINT*,"student no = ",j,"has obtained B GRADE"
ELSE IF(sum>=150)THEN
PRINT*,"student no = ",j,"has obtained C GRADE"
ELSE IF(sum>=100)THEN
PRINT*,"student no = ",j,"has obtained D GRADE"
ELSE IF(sum<100)THEN
PRINT*,"student no = ",j,"has FAILED"
END IF
END DO
END PROGRAM student_grade

9
10. Sub function program
REAL FUNCTION S(X)

IMPLICIT NONE

REAL,INTENT(IN)::X

IF(X<3.0)THEN

S=-3.0

ELSE IF(X>3.0)THEN

S=3.0

ELSE

S=X

END IF

END FUNCTION S

PROGRAM FUNCTION

IMPLICIT NONE

REAL::A,B,S,Z

PRINT*,"TYPE A &B"

READ*,A,B

Z=(S(A)+S(B))/S(A+B)

PRINT*,"VALUE= ",Z

END PROGRAM FUNCTION

10
11. Roots of equation ( By using subroutine)

program use_roots
Implicit none
integer::flag,serial
real::p,q,r,x_r1,x_r2,x_im1,x_im2
serial=0
do
serial=serial+1
if(serial==2)EXIT

read*,p,q,r
call roots(p,q,r,x_r1,x_r2,x_im1,x_im2,flag)

select case(flag)
case(1)
print*,"Linear equation only one root"
print*,"root=",x_r1

case(2)
print*,"two real roots"
print*,"root=",x_r1,"root2=",x_r2

case(3)
print*,"complex conjugate roots"
print*,"root1=",x_r1,"+i",x_im1
print*,"root2=",x_r2,"+i",x_im2

end select
end do
end program use_roots

subroutine roots(a,b,c,x_real1,x_real2,x_img1,x_img2,i)
implicit none
real::diser,d !loacal variables

11
real,intent(in)::a,b,c
real,intent(out)::x_real1,x_real2,x_img1,x_img2
integer,intent(out)::i
real,parameter::epsilon=0.5E-6
if(ABS(a)<=epsilon) then
x_real1=-c/b;x_real2=0
x_img1=0;x_img2=0
i=1
return
end if
diser=b*b-4*a*c
if(diser>0) then
d=sqrt(diser);i=2
x_real1=-0.5*(-b+d)/a
x_real2=0.5*(-b-d)/a
x_img1=0;x_img2=0
else
d=sqrt(-diser);i=3
x_real1=-0.5*b/a;x_real2=x_real1;
x_img1=0.5*d/a;x_img2=-x_img1;
end if

end subroutine roots

12