Fortran Tutorials with large numbers of examples

 

                                                             Fortran Examples

                                                                 Bapon Kar

Exploring Fortran: 

The Pioneering Language of Scientific Computing 

 Introduction: Fortran, short for "Formula Translation," stands as one of the earliest high-level programming languages, specifically designed for numerical and scientific computation. Developed in the 1950s by IBM engineer John Backus and his team, Fortran revolutionized the field of computing by providing a more efficient and accessible means of expressing mathematical algorithms for complex calculations. Over the decades, Fortran has evolved significantly, with modern versions offering advanced features while retaining its core principles of performance and reliability.

 Historical Context: Fortran emerged during a time when computers were rapidly advancing, yet programming was primarily done in low-level languages like assembly or machine code. Recognizing the need for a higher-level language tailored to scientific computation, Backus and his team set out to develop Fortran. The language's success was immediate, and it quickly gained popularity among scientists, engineers, and researchers worldwide. 

 Key Features and Contributions:

1. Simplicity and Expressiveness: Fortran was designed to closely resemble mathematical notation, making it intuitive for scientists and mathematicians to translate their formulas into code. 

 2. Efficiency: Early Fortran compilers were highly efficient, producing code that could rival hand-written assembly in terms of speed and optimization. 

 3. Portability: Fortran introduced the concept of machine-independent programming, allowing users to write code that could be easily ported across different computer architectures. 

 4. Standardization: The development of Fortran led to the establishment of formal language standards, ensuring compatibility and interoperability across different implementations.

 Evolution and Modernization: Fortran has seen several major revisions over the years, each introducing new features and enhancements. Fortran 77, released in 1977, standardized many language features and introduced structured programming constructs. Subsequent versions, including Fortran 90, 95, 2003, 2008,  2018 and 2023, brought further improvements such as dynamic memory allocation, object-oriented programming support, and enhanced parallelism. 

 Current Relevance: Despite the emergence of newer programming languages, Fortran remains widely used in scientific and engineering fields where performance and numerical accuracy are paramount. It continues to power critical applications in areas such as weather forecasting, computational physics, aerospace engineering, and high-performance computing. 

 Conclusion: Fortran's enduring legacy as the pioneering language of scientific computing underscores its importance in shaping the modern computational landscape. From its humble beginnings as a tool for mathematical expression to its status as a cornerstone of scientific research and engineering, Fortran continues to inspire and empower generations of programmers and scientists to push the boundaries of computational possibility. As technology advances, Fortran stands ready to meet the challenges of tomorrow's scientific endeavors with its unmatched blend of efficiency, reliability, and versatility.

Test your fortran code from here.

Here I am presenting all of my Fortran programs :

1. write a program to read the radius of a circle and compute its area and circumference .

	program circular_case
	implicit none
	real :: radius,area,circumference
	read*,radius
	print*,"radius=",radius,"unit"
	circumference=2*22*radius/7
	print*,"circumference=",circumference,"unit"
	area= 22*(radius**2)/7
	print*,"area=",area,"square unit"
	end program circular_case

view raw circle_area.f95 hosted with ❤ by GitHub

2. Write a program to convert Celsius temperature to fahrenheit.

	Program fahrenheit_celsius
	Program fahrenheit_celsius
	implicit none
	real :: fahrenheit,celsius
	read*,celsius
	fahrenheit=(9*celsius)/5+32
	print*,"celsius=",celsius," ","fahrenheit=",fahrenheit
	end program fahrenheit_celsius
	implicit none
	real :: fahrenheit,celsius
	read*,celsius
	fahrenheit=(9*celsius)/5+32
	print*,"celsius=",celsius," ","fahrenheit=",fahrenheit
	end program fahrenheit_celsius

view raw c2f.f95 hosted with ❤ by GitHub

3. Write aprogram to convert pounds to kilogram.

	!Write aprogram to convert pounds to kilogram.
	program pound_kg
	implicit none
	real :: pound,kg
	read*,pound
	print*,"pound=",pound
	kg=pound*0.4536
	print*,"kg=",kg
	end program pound_kg

view raw lb2kg.f95 hosted with ❤ by GitHub

4. write a program to evalute the following expression $$w=\frac{a}{s(s-a)}$$ $$x=wa$$ $$t=\frac{x}{s^(-a)}$$

	program arithmetic_expression
	implicit none
	real ::a,s,w,x,t
	Print*,"please type the value of 'a','s' ;(where 'a' not equal to 's')"
	read*,a,s
	print*,"a=",a,"s=",s
	w=a/(s*(s-a))
	x=w*a
	t=x/(s**(-a))
	print*,"w=",w,"x=",x,"t=",t
	end program arithmetic_expression

view raw arithmatic_exp.f95 hosted with ❤ by GitHub

5. Write a program to evalute T from $$T=.0092\cdot 2a \cdot [log(4a^{\frac{2}{b}})-log(\sqrt{2-L})]+0.004 \cdot [a^2 \cdot (\sqrt{2-L} +0.45 \cdot b]$$ where given a=15.2, b=10.2, L=1.2

	program calculation_of_T
	implicit none
	real::T,a,b,L
	print*,"please type the values of 'a','b','L'."
	read*,a,b,L
	print*,"a=",a,"b=",b,"L=",L
	print*,"T=.0092*2a*(log(4a**2/b)-log(asqrt(2-L))]+0.004*[a**2*(asqrt(2-L) +0.45*b)"
	T=.00092*2.0*a*(log 10(4.0*(a**2)/b)-log 10(a*(sqrt(2-L)))) + 0.004*((a*(a*(sqrt(2-L)))) + 0.45*b)
	print*,"T=",T
	end program calculation_of_T

view raw find_T.f95 hosted with ❤ by GitHub

6. Given the x,y coordinates of a point write a program to find its r,$\theta$ coordinates \(r=\sqrt{x^2+y^2},\theta= tan^{-1}(\frac{y}{x})\)

	program cartesian_to_polar_coordinate
	implicit none
	real ::x,y,r,theta
	real,parameter ::pi=3.141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067
	print*,"please entre the values of 'x' and 'y' with comma in between them"
	read*,x,y
	print*,"x=",x,"y=",y
	r=sqrt(x**2+y**2)
	theta=atan(y/x)!theta in radian
	theta=180*theta/pi
	print*,"r=",r,"theta=",theta,"degree"
	end program cartesian_to_polar_coordinate

view raw cart_2_pol.f95 hosted with ❤ by GitHub

7. Given a five digit number write a program which will reverse the digit and print it.

	program five_digit_number_to_reverse_digit
	implicit none
	integer::number,digit1,digit2,digit3,digit4,digit5,reverse_number
	print*,"please entre the five digits number which digits would be reverse"
	read*,number
	print*,"the number is=",number
	digit1=mod(number,10)!give first digit
	number=number*.1!number became four digit
	digit2=mod(number,10)!getting second digit
	number=number*.1!number become three digit
	digit3=mod(number,10)!getting third digit
	number=number*.1!number become two digit
	digit4=mod(number,10)!getting fourth digit
	number=number*.1!number now became one digit this is the fifth digit
	digit5=mod(number,10)
	reverse_number=digit5*1+digit4*10+digit3*100+digit2*1000+digit1*10000
	print*,"The revrese number is=",reverse_number
	end program five_digit_number_to_reverse_dig

view raw rev_digit.f95 hosted with ❤ by GitHub

8. Given values for a,b,c and d and a set of values for the variable x evaluate the function \(f(x)\). defiend by \(f(x)=ax^2+bx+c\) for \( x\lt d \), \( f(x)=0 \) for \(x=d\) ,\(f(x)=-ax^2+bx-c \) for \( x\gt d \).

	program function_x
	implicit none
	real::f_x,x,a,b,c,d
	print*,"Input a,b,c,d"
	read*,a,b,c,d,x
	print*,"a=",a,"b=",b,"c=",c,"d=",d,"x=",x
	if(x<d)then
	f_x=a*(x**2)+b*x+c
	else
	if (x==d)then
	f_x=0
	else if(f_x>d)then
	f_x=-a*(x**2)+b*x-c
	endif
	endif
	print*,"f(x)=",f_x
	end program function_x

view raw find_func.f95 hosted with ❤ by GitHub

9. Write a program which will evaluate the function f for the set of values of x(0.5,1,1.5,2,2.5,3) !and tabulate the results Where $$f(x) = 1+(x^2)/(2\times1)+(x^4)/(4\times 3 \times 2 \times 1)-50\times {\sin}^2{x}+\sqrt{4-x^2}$$

	program func_tabulation
	implicit none
	real::f_x,x
	integer::i!how many do reapet perfrom
	x=0!initial value its value changing with 0.5 inside of do loop
	print*,"x"," ","f(x)"
	do i=1,6,1!we get six result
	x=x+.5
	f_x=1+(x**2)/(2*1)+(x**4)/(4*3*2*1)-50*(sin(x))**2+(4-(x**2))**.5
	print*,x,f_x
	enddo
	end program func_tabulation

view raw tabulation_func.f95 hosted with ❤ by GitHub

10. Octal to Decimal Conversion

	program octal_decimal
	implicit none
	integer::octal_num,decimal_num,octal_digit,decimal_digit,i
	decimal_num=0
	i=-1
	print*,"Input the octal number"
	read*,octal_num
	print*,"The Octal number is=",octal_num
	do
	if(octal_num==0)then
	exit
	else
	octal_digit=mod(octal_num,10)
	octal_num=octal_num/10
	i=i+1
	decimal_num=octal_digit*(8**i)+decimal_num
	endif
	enddo
	print*,"Decimal equivalent number is=",decimal_num
	print*,"last power",i
	end program octal_decimal

view raw oct2dec.f95 hosted with ❤ by GitHub

11. Checking Palindrome number

	program palindrome
	implicit none
	integer::x,digit,rev_x,y
	rev_x=0
	print*,"Type the number"
	read*,y
	print*,"number is",y
	x=y
	do
	if(x==0)then
	exit
	else
	digit=mod(x,10)
	x=x*0.1
	rev_x=(rev_x+digit)*10
	endif
	enddo
	rev_x=rev_x/10
	print*,"The reverse of the typed number is=",rev_x
	if(y==rev_x)then
	PRINT*,"The number is a palindrome number"
	else
	print*,"The number is not a palindrome number"
	endif
	print*,y
	end program palindromeprogram palindrome
	implicit none
	integer::x,digit,rev_x,y
	rev_x=0
	print*,"Type the number"
	read*,y
	print*,"number is",y
	x=y
	do
	if(x==0)then
	exit
	else
	digit=mod(x,10)
	x=x*0.1
	rev_x=(rev_x+digit)*10
	endif
	enddo
	rev_x=rev_x/10
	print*,"The reverse of the typed number is=",rev_x
	if(y==rev_x)then
	PRINT*,"The number is a palindrome number"
	else
	print*,"The number is not a palindrome number"
	endif
	print*,y
	end program palindrome

view raw palindrom.f95 hosted with ❤ by GitHub

12. Finding position of a 2D pont among 4 quadrunt

	program point_position
	implicit none
	real ::x,y
	print*,"Please type point x,y"!this program find the position of a point among four quadrant
	read*,x,y
	print*,"x=",x,"y=",y
	if (x>0)then
	if(y>0) then
	print*,"the point lies on First quadrant"
	else
	print*,"The point lies on Fourth quadrant"
	endif
	else
	if(y>0)then
	print*,"The point lies on Second quadrant"
	else
	print*,"The point lies on Fourth quadrant"
	endif
	endif
	end program point_position

view raw find_quadrunt.f95 hosted with ❤ by GitHub

13. Newton Raphson Method to finding root of equation \(e^x = 2x + 1\)

	!Find out the root of the equation exp(x) = 2x + 1 by Newton-Raphson method
	PROGRAM NEWTON_RAPHSON
	IMPLICIT NONE
	REAL::F,X(0:100),TEMP,del_f
	INTEGER::I,J,K
	PRINT*,"ENTER INITIAL VALUES OF X"
	READ*,X(0)
	DO I=0,99
	print*,X(I)
	X(I+1)=X(I)-F(X(I))/DEL_F(X(I))
	END DO
	PRINT*,"THE REQUIRED ROOT IS:",X(100)
	END PROGRAM NEWTON_RAPHSON
	REAL FUNCTION F(X)
	IMPLICIT NONE
	REAL,INTENT(IN)::X
	F=EXP(X)-2*X-1
	END FUNCTION F
	REAL FUNCTION DEL_F(X)
	IMPLICIT NONE
	REAL,INTENT(IN)::X
	DEL_F=EXP(X)-2
	END FUNCTION DEL_F

view raw newton_raphson.f95 hosted with ❤ by GitHub

14. Finding determinant of any square matrix.

	!FINDING THE DETERMINANT OF A MATRIX BY MAKING UPPER TRAINGULAR FORM
	!TRHIS PROGRAM CAN FIND ANY TWO DIMENSIONAL SQUARE MATRIX DETERMINANT
	!THIS PROGRAM WRITTEN BY BAPON KAR
	PROGRAM FIND_DET
	IMPLICIT NONE
	REAL::MAT(1000,1000),TEMP,DET=1
	INTEGER::N,I,J,K,L
	PRINT*,"ENTER THE ROW NUMBER OF THE SQUARE MATRIX"
	READ*,N
	PRINT*,"ENTER THE ELEMENTS OF THE MATRIX BY ROW WISE"
	DO I=1,N
	DO J=1,N
	READ*,MAT(I,J)
	END DO
	END DO
	PRINT*,"YOUR'S MATRIX IS:"
	DO I=1,N
	PRINT*,(MAT(I,J),J=1,N)
	END DO
	!NOW NEXT STEP FIND OUT THE UPPER TRAINGULAR MATRIX
	DO L=1,N-1
	DO I=L+1,N
	TEMP=MAT(I,L)/MAT(L,L)
	DO J=L,N
	MAT(I,J)=MAT(I,J)-TEMP*MAT(L,J)
	END DO
	END DO
	END DO
	PRINT*,"THE CORRESPONDING UPPER TRAINGULAR MATRIX IS:"
	DO I=1,N
	PRINT*,(MAT(I,J),J=1,N)
	END DO
	!PRODUCT OF DIAGONAL TERMS
	DO I=1,N
	DET=DET*MAT(I,I)
	END DO
	PRINT*,"THE REQUIRED DETERMINANT OF THE GIVEN MATRIX IS:",DET
	END PROGRAM FIND_DET

view raw det_nxn.f95 hosted with ❤ by GitHub

15. Generating Prime number in between two range.

	!THIS PROGRAM PRINTING LIST OF NUMBERS IN BETWEEN LOWER AND UPPER RANGE
	PROGRAM PRIME_PRINT
	IMPLICIT NONE
	INTEGER::LOW,UP,NO,I,J
	LOGICAL::PRIME_CHECK
	PRINT*,"ENTER \'LOWER & UPPER RANGE'\ NUMBER"
	READ*,LOW,UP
	DO I=LOW,UP
	NO=I
	IF(PRIME_CHECK(NO) .EQV. .TRUE.)THEN
	PRINT*,NO
	ENDIF
	END DO
	END PROGRAM PRIME_PRINT
	LOGICAL FUNCTION PRIME_CHECK(N)
	IMPLICIT NONE
	INTEGER,INTENT(IN)::N
	INTEGER::I,J
	DO I=2,INT(SQRT(REAL(N)))
	IF (MOD(N,I) == 0) THEN
	PRIME_CHECK=.FALSE.
	EXIT
	ELSE
	PRIME_CHECK=.TRUE.
	ENDIF
	END DO
	END FUNCTION PRIME_CHECK
	ISIGN

view raw prime_generator.f95 hosted with ❤ by GitHub

16. Small Computer Simulation Program

	!SIMULATOR FOR SMALL COMPUTER
	PROGRAM SMAC
	IMPLICIT NONE
	INTEGER::INST_COUNTER=0,ADDRESS,OP_CODE,INSTRN,ACC=0,INST_REG,LOCATION
	INTEGER,DIMENSION(0:99) :: MEMORY
	LOGICAL :: HALT= .FALSE.
	!THE FOLLOWING LOOP READS SMAC MACHINE LANGUAGE PROGRAM
	!GIVEN AS DATA TO SIMULATOR AND STORES IN SMAC MEMORY
	PRINT*,"NOW ENTER YOUR MACHINE CODE FOLLOWING WAY"
	PRINT*,"MEMORY_LOCATION_WITH_THREE_DIGIT,TWO SPACE,OP_CODE_WITH_TWO_DIGIT,TWO_SPACE,MEMORY_ADDRESS_WITH_THREE_DIGIT"
	DO
	READ 10,LOCATION,OP_CODE,ADDRESS
	10 FORMAT(I3,2X,I2,2X,I3)
	IF(LOCATION <0 ) THEN
	EXIT
	ENDIF
	IF(INST_COUNTER>999)THEN
	PRINT*,"PROGRAM OVERFLOWS MEMORY"
	STOP
	ENDIF
	INSTRN = OP_CODE*1000+ADDRESS
	MEMORY(INST_COUNTER)=INSTRN
	INST_COUNTER=INST_COUNTER+1
	END DO
	!STORING PROGRAM OVER
	!THIS PHASE MACHINE LANGUAGE INSTRUCTIONS ARE RETRIVED ONE
	!BYE ONE FROM SMAC 'S MEMORY INTERPRETED AND EXECUTED BY THE
	!FOLLOWING PART OF SIMULATOR PROGRAM
	INST_COUNTER=0
	DO
	IF(HALT)THEN
	EXIT
	ELSE
	INST_REG=MEMORY(INST_COUNTER)
	OP_CODE=INST_REG/1000
	IF(OP_CODE<0 .OR. OP_CODE>11)THEN
	PRINT*,"ILLEGAL OP CODE ENTRY"
	PRINT*,"INST-COUNTER=",INST_COUNTER,"OP_CODE=",OP_CODE
	STOP
	ENDIF
	ADDRESS=MOD(INST_REG,1000)
	INST_COUNTER=INST_COUNTER+1
	SELECT CASE(OP_CODE)
	CASE(1)
	ACC=MEMORY(ADDRESS) !LOAD UP ACCUMULATOR
	CASE(2)
	ACC=ACC+MEMORY(ADDRESS) !ADDING CONTENT OF ACCUMULATOR AND THE MEMORY ADDRESS CONTENT
	CASE(3)
	ACC =ACC-MEMORY(ADDRESS) !SUBTRACT MEMORY CONTENT FROM CONTENT OF ACCUMULATOR
	CASE(4)
	ACC=ACC*MEMORY(ADDRESS) !PRODUCT OF ACCUMULATOR AND MEMORY CONTENT
	CASE(5)
	IF(MEMORY(ADDRESS)==0)THEN !DIVISION BY MEMORY CONTENT
	PRINT*,"ATTEMPT TO DIVIDING BY ZERO"
	PRINT*,"INSTRUCTION-COUNTER=",INST_COUNTER-1,OP_CODE,ADDRESS
	ELSE
	ACC=ACC/MEMORY(ADDRESS)
	ENDIF
	CASE(6)
	MEMORY(ADDRESS)=ACC !LOADING MEMORY WITH ACCUMULATOR CONTENT
	CASE(7)
	INST_COUNTER=ADDRESS !UNCONDITIONAL JUMP
	CASE(8)
	IF(ACC<0)THEN
	INST_COUNTER=ADDRESS !IF ACCUMULATOR GET NEGATIVE JUMP INTO THE ADDRESS
	ENDIF
	CASE(9)
	READ*,MEMORY( ADDRESS ) !STORING MEMORY FROM OUTPUT
	CASE(10)
	HALT= .TRUE. !HALT THE PROGRAM
	CASE(11)
	END SELECT
	ENDIF
	END DO
	PRINT*,"PROGRAM TERMINATES NORMALLY"
	PRINT*,"INSTRUCTION COUNTER=",INST_COUNTER-1
	END PROGRAM SMAC

view raw sim.f95 hosted with ❤ by GitHub

17. Roman number to Decimal number conversion.

	!THIS PROGRAM FINDING THE DECIMAL EQUIVALENT OF A ROMAN NUMBER
	!I=1,II=2,III=3,IV=4,V=5,VI=6,VII=7,VIII=8,IX=9,X=10,XL=40,L=50,XC=90,C=100
	!CM=900,M=1000,V_BAR=5000,X_BAR=10000,C_BAR=100000,M_BAR=1000000;;XLIV==44;LXXXII=82
	PROGRAM ROM_TO_DEC
	IMPLICIT NONE
	INTEGER::DEC=0,I,J,L,DIG(1:10),BIG_DIG=0,BIG_POS
	CHARACTER(LEN=10)::ROM,ROM_DIG
	INTEGER::ROMAN_DIGIT
	!INITIALISE ALL DIGIT TO ZERO
	DO I=1,10
	DIG(I)=0
	END DO
	PRINT *,"ENTER A ROMAN NUMBER"
	READ 10,ROM
	10 FORMAT(A10)
	ROM=TRIM(ROM)
	L=LEN_TRIM(ROM)!this is trimming for any space
	!NOW FINDOUT THE DIGIT OF ROMAN NUMBER
	DO I=1,L
	ROM_DIG=ROM(I:I)
	DIG(I)=ROMAN_DIGIT(ROM_DIG)
	IF(DIG(I)>BIG_DIG)THEN
	BIG_DIG=DIG(I)
	BIG_POS=I
	ENDIF
	END DO
	DO I=1,L
	IF(I<BIG_POS)THEN
	DEC=DEC-DIG(I)
	ELSE
	DEC=DEC+DIG(I)
	ENDIF
	END DO
	PRINT 100,DEC
	100 FORMAT(2X,"DECIMAL EQUIVALENT NUMBER IS:",I4)
	END PROGRAM ROM_TO_DEC
	INTEGER FUNCTION ROMAN_DIGIT(N)
	IMPLICIT NONE
	CHARACTER(LEN=1),INTENT(IN)::N
	! SELECT CASE(N)
	! CASE("I")
	! ROMAN_DIGIT=1
	! CASE("V")
	! ROMAN_DIGIT=5
	! CASE("X")
	! ROMAN_DIGIT=10
	! CASE("L")
	! ROMAN_DIGIT=50
	! CASE("C") !this function finding each digit of roman number into decimal equivalent number
	! ROMAN_DIGIT=100
	! CASE("M")
	! ROMAN_DIGIT=1000
	! END SELECT
	IF(N=="I" .OR. N=="i")THEN
	ROMAN_DIGIT=1
	ELSEIF(N=="V" .OR. N=="v")THEN
	ROMAN_DIGIT=5
	ELSEIF(N=="X" .OR. N=="x")THEN
	ROMAN_DIGIT=10
	ELSEIF(N=="L" .OR. N=="l")THEN
	ROMAN_DIGIT=50
	ELSEIF(N=="C" .OR. N=="c")THEN
	ROMAN_DIGIT=100
	ELSEIF(N=="M" .OR. N=="m")THEN
	ROMAN_DIGIT=1000
	ENDIF
	END FUNCTION ROMAN_DIGIT

view raw rom_2_dec.f95 hosted with ❤ by GitHub

18. Hexadecimal to Decimal number conversion.

	!THIS PROGRAM CONVERT HEXADECIMAL INTO DECIMAL NUMBER
	PROGRAM HEX_TO_DEC
	IMPLICIT NONE
	INTEGER::DEC=0,I,J,L,CONV
	INTEGER::DIG(0:100)
	CHARACTER(LEN=10)::HEX
	CHARACTER(LEN=1)::HEX_DIG
	DO I=0,100
	DIG(I)=0
	END DO
	PRINT*,"ENTER A HEXADECIMAL NUMBER"
	READ*,HEX
	L=LEN_TRIM(HEX)
	HEX=TRIM(HEX)
	!FINDING THE COEFFICIENTS
	DO I=0,L-1
	DIG(I)=CONV(HEX((I+1):(I+1)))
	PRINT*,DIG(I)
	END DO
	J=L-1
	print*,"length=",L
	DO I=0,(L-1)
	DEC=DEC+DIG(I)*(16**J)
	J=J-1
	END DO
	PRINT*,"THE DECIMAL EQUIVALENT NUMBER:",DEC
	END PROGRAM HEX_TO_DEC
	INTEGER FUNCTION CONV(X)
	IMPLICIT NONE
	CHARACTER(LEN=1),INTENT(IN)::X
	SELECT CASE(X)
	CASE("0")
	CONV=0
	CASE("1")
	CONV=1
	CASE("2")
	CONV=2
	CASE("3")
	CONV=3
	CASE("4")
	CONV=4
	CASE("5")
	CONV=5
	CASE("6")
	CONV=6
	CASE("7")
	CONV=7
	CASE("8")
	CONV=8
	CASE("9")
	CONV=9
	CASE("A")
	CONV=10
	CASE("B")
	CONV=11
	CASE("C")
	CONV=12
	CASE("D")
	CONV=13
	CASE("E")
	CONV=14
	CASE("F")
	CONV=15
	END SELECT
	END FUNCTION CONV

view raw hex_2_dec.f95 hosted with ❤ by GitHub

19. Decimal to Hexadecimal conversion

	PROGRAM DEC_TO_HEX
	IMPLICIT NONE
	INTEGER::DEC,I,J,DEC_DIG,TEMP_DEC,DIV=1,REM!here i initialise div to 1 otherwise it taking initial value div=0
	CHARACTER(LEN=100)::HEX=""
	CHARACTER(LEN=1)::HEX_DIG,CONV
	PRINT*,"ENTER A DECIMAL NUMBER"
	READ*,DEC
	TEMP_DEC=DEC
	DO
	IF(DIV==0)THEN
	EXIT
	ELSE
	REM=MOD(TEMP_DEC,16)
	HEX_DIG=CONV(REM)
	HEX=TRIM(HEX_DIG)//TRIM(HEX)
	DIV=TEMP_DEC/16
	TEMP_DEC=DIV
	ENDIF
	END DO
	PRINT*,"HEX EQV. NUMBER :",HEX
	END PROGRAM DEC_TO_HEX
	CHARACTER FUNCTION CONV(X)
	IMPLICIT NONE
	INTEGER,INTENT(IN)::X
	SELECT CASE(X)
	CASE(0)
	CONV="0"
	CASE(1)
	CONV="1"
	CASE(2)
	CONV="2"
	CASE(3)
	CONV="3"
	CASE(4)
	CONV="4"
	CASE(5)
	CONV="5"
	CASE(6)
	CONV="6"
	CASE(7)
	CONV="7"
	CASE(8)
	CONV="8"
	CASE(9)
	CONV="9"
	CASE(10)
	CONV="A"
	CASE(11)
	CONV="B"
	CASE(12)
	CONV="C"
	CASE(13)
	CONV="D"
	CASE(14)
	CONV="E"
	CASE(15)
	CONV="F"
	END SELECT
	END FUNCTION CONV

view raw dec_2_hex.f95 hosted with ❤ by GitHub

20. Runge Kutta Method to solve a differential equation.

	!RUNGE-KUTTA METHOD
	!PROBLEM::Given dy/dx=y-x,y(0)=2.Find y(0.1) and y(0.2) using second order Runge-Kutta method
	PROGRAM RUNGE_KUTTA_2ND_ORDER
	IMPLICIT NONE
	INTEGER::I,J,N,OK
	REAL::X0,Y0,H,XF,F
	REAL,ALLOCATABLE::X(:),Y(:)
	PRINT*,"ENTER THE INITIAL VALUE OF X AND Y"
	READ*,X0,Y0
	PRINT*,"ENTER THE DIVISION VALUE I.E H"
	READ*,H
	PRINT*,"ENTER THE VALUE OF X WHERE THE SOLUTION BE FINDING"
	READ*,XF
	N= (XF-X0)/H
	ALLOCATE(X(N+1),Y(N+1),STAT=OK)
	X(1)=X0
	Y(1)=Y0
	DO I=1,N+1
	X(I+1) = X(I)+H
	Y(I+1) =Y(I)+0.5*H* (F(X(I),Y(I)) + F( X(I)+H , Y(I)+H*F(X(I),Y(I)) ))
	END DO
	PRINT*,"X=",X(N+1),"Y=",Y(N+1)
	END PROGRAM RUNGE_KUTTA_2ND_ORDER
	FUNCTION F(X,Y)
	IMPLICIT NONE
	REAL,INTENT(IN)::X,Y
	REAL :: F
	F= Y-X
	END FUNCTION F

view raw runge_kutta_solve_diff_eqn.f95 hosted with ❤ by GitHub

21.Euler method to solve a differential equation.

	!EULER METHOD TO SOLVE A DIFFERENTIAL EQUATION
	!PROBLEM::SOLVE NUMERICALLY THE DIFFERENTIAL EQUATION dy/dx=1/2(y^3-y/x) using Euler's method at x=1.6,given that y=1 when x=1
	!Also find the exact value at x=1.6
	PROGRAM EULER_METHOD
	IMPLICIT NONE
	INTEGER::I,J,N,OK
	REAL::F,X0,Y0,H,XF
	REAL,ALLOCATABLE::X(:),Y(:)
	PRINT*,"ENTER THE INITIAL VALUE OF X AND Y"
	READ*,X0,Y0
	PRINT *,X0,Y0
	PRINT *,"ENTER THE VALUE OF X WHERE THE SOLUTION WILL FIND"
	READ*,XF
	PRINT*,"ENTER THE VALUE OF H"
	READ*,H
	N= (XF-X0)/H
	ALLOCATE(X(N+1),Y(N+1),STAT=OK)
	X(1)=X0
	Y(1)=Y0
	IF(OK == 0)THEN
	DO I=1,N+1
	X(I+1)=X(I)+H
	Y(I+1)=Y(I)+H*F(X(I),Y(I))
	END DO
	ELSE
	PRINT*,"ALLOCATION FAILURE"
	ENDIF
	PRINT *,"THE SOLUTION :"
	PRINT 10,X(N+1)
	10 FORMAT(2X,"X=",F4.1)
	PRINT 20,Y(N+1)
	20 FORMAT(2X,"Y=",F7.4)
	END PROGRAM EULER_METHOD
	FUNCTION F(X,Y)
	IMPLICIT NONE
	REAL,INTENT(IN)::X,Y
	REAL::F
	F=0.5*(Y**3-Y/X)
	END FUNCTION F

view raw euler_met_solve.f95 hosted with ❤ by GitHub

22. Newton's Bi-section method to finding root of a equation.

	!FINDING THE ROOT OF A EQUATION BY BISECTION METHOD
	PROGRAM BISECTION_METHOD
	IMPLICIT NONE
	INTEGER::I,J
	REAL::F,X1,X2,ROOT,TEMP
	PRINT*,"ENTER FIRST BOUNDERY VALUE OF A ROOT"
	READ*,X1
	PRINT*,"ENTER SECOND BOUNDERY VALUE OF THE ROOT"
	READ*,X2
	DO I=1,100
	IF(F(X1)*F(X2) < 0)THEN
	TEMP=(X1+X2)/2
	IF(F(X1)*F(TEMP) < 0 )THEN
	X2=TEMP
	ELSEIF(F(X2)*F(TEMP) < 0) THEN
	X1=TEMP
	ENDIF
	ELSE
	PRINT*,"NO ROOT AVAILABLE IN BETWEEN THIS BOUNDERY VALUE"
	END IF
	END DO
	ROOT=X2
	PRINT*,"ROOT=",ROOT
	END PROGRAM BISECTION_METHOD
	REAL FUNCTION F(X)
	IMPLICIT NONE
	REAL,INTENT(IN)::X
	F=X*TAN(X) - 1.28
	END FUNCTION F

view raw bisec.f95 hosted with ❤ by GitHub

23. Finding Mean , Median and Standard Deviation.

	!FINDING MEAN,MEDIAN AND STANDARD DEVIATION
	PROGRAM MEAN_MEDIAN_SD
	IMPLICIT NONE
	REAL::DAT(100),VAR(100),SIGMA_SQ=0,SIGMA,MEAN,MEDIAN,SD,DAT_SUM=0
	INTEGER::N,I,J
	PRINT*,"HOW MANY DATA YOU HAVE"
	READ*,N
	PRINT*,"ENTER THE DATA"
	DO I=1,N
	READ*,DAT(I)
	DAT_SUM=DAT_SUM+DAT(I)
	END DO
	IF(MOD(N,2) == 0 ) THEN
	J=N/2
	MEDIAN=DAT(J)
	ELSE
	J=N/2
	MEDIAN=(DAT(J)+DAT(J+1))/2
	ENDIF
	MEAN=DAT_SUM/N
	DO I=1,N
	VAR(I)=MEAN-DAT(I)
	SIGMA_SQ=SIGMA_SQ+VAR(I)**2
	END DO
	SIGMA_SQ=SIGMA_SQ/(N-1)
	SIGMA=SQRT(REAL(SIGMA_SQ))
	PRINT*,"MEAN=",MEAN,";","MEDIAN=",MEDIAN,";","STANDARD DEVIATION=",SIGMA
	END PROGRAM MEAN_MEDIAN_SD

view raw std_dev.f95 hosted with ❤ by GitHub

24. FINDING SOLUTION OF ALGEBRIC EQUATIONS BY USING GAUSS'S ELIMINATION METHOD

	!FINDING SOLUTION OF ALGEBRIC EQUATIONS BY USING GAUSS'S ELIMINATION METHOD
	PROGRAM GAUSS_ELIMINATION
	IMPLICIT NONE
	REAL::AUG(100,100),TEMP,X(100)
	INTEGER::I,J,K,L,R,C
	PRINT*,"ENTER THE ROW AND COLUMN OF AUGMENTED MATRIX"
	READ*,R,C
	PRINT*,"ENTER THE ELEMENTS OF THE AUGMENTED MATRIX"
	DO I=1,R
	DO J=1,C
	READ*,AUG(I,J)
	END DO
	END DO
	!NOW PERFORMING THE PROCESS TO MAKE UPPER TRAINGULAR FORM
	DO L=1,R-1
	DO I=L+1,R
	TEMP=AUG(I,L)/AUG(L,L)
	DO J=1,C
	AUG(I,J)=AUG(I,J)-TEMP*AUG(L,J)
	END DO
	END DO
	END DO
	!PRINTING UPPER TRAINGULAR MATRIX
	PRINT*,"UPPER TRANGULAR MATRIX"
	DO I=1,R
	PRINT*,(AUG(I,J),J=1,C)
	END DO
	DO I=1,R
	X(I)=0
	END DO
	!NOW SOLVE THE EQUATION FROM UPPER TRAINGULAR MATRIX
	PRINT*,"YOUR'S RESULT:"
	X(R)=AUG(R,C)/AUG(R,C-1) !LAST VALUE OF X
	PRINT*,"X(",R,") :",X(R)
	DO L=R-1,1,-1
	TEMP=0
	DO I=L+1,C-1
	TEMP = TEMP+AUG(L,I)*X(I)
	END DO
	X(L) = (AUG(L,C)-TEMP)/AUG(L,L)
	PRINT*,"X(",L,") :",X(L)
	END DO
	END PROGRAM GAUSS_ELIMINATION

view raw guess.f95 hosted with ❤ by GitHub

25. THIS PROGRAM FINDING ROOT OF A QUADRATIC EQUATION

	!THIS PROGRAM FINDING ROOT OF A QUADRATIC EQUATION
	PROGRAM QUAD_EQN
	IMPLICIT NONE
	REAL::A1,A2,A3,X1,X2
	INTEGER::FLAG
	PRINT*,"ENTER THE COEFFICIENTS OF X IN THE EQUATION"
	READ*,A1,A2,A3
	CALL SOLVE(A1,A2,A3,X1,X2,FLAG)
	IF(FLAG ==0)THEN
	PRINT*,"FIRST ROOT:",X1,"SECOND ROOT:",X2
	ELSE
	PRINT 10,"FIRST ROOT:",X1,"+i",X2,"SECOND ROOT:",X1,"-i",X2
	10 FORMAT(2X,A11,F6.2,A2,F6.2,2X,A12,F6.2,A2,F6.2)
	ENDIF
	END PROGRAM QUAD_EQN
	SUBROUTINE SOLVE(A1,A2,A3,X1,X2,FLAG)
	IMPLICIT NONE
	REAL,INTENT(IN)::A1,A2,A3
	REAL,INTENT(OUT)::X1,X2
	INTEGER,INTENT(OUT)::FLAG
	REAL::TEMP
	FLAG=0
	TEMP=A2*A2-4*A1*A3
	IF(TEMP > 0)THEN
	X1=(-A2-SQRT(REAL(TEMP)) )/(2*A1)
	X2=(-A2+SQRT(REAL(TEMP)) )/(2*A1)
	ELSEIF(TEMP<0)THEN
	FLAG=1
	X1=-A2/2*A1
	X2=SQRT(REAL(-TEMP))/2*A1
	ELSE
	X1=-A2/A1
	X2=-A2/A1
	ENDIF
	END SUBROUTINE

view raw quad_eqn_solve.f95 hosted with ❤ by GitHub

26. Finding root of a cubic equation.

	program root
	implicit none
	real :: x,z,f,nxt_x
	integer :: i
	x = 2.0
	z = f(x)
	do i=1, 1000
	z = f(x)
	nxt_x = f(x)
	x = nxt_x
	end do
	print*,"z",z
	end program root
	real function f(x)
	implicit none
	real intent in :: x
	f = (1.0 + x)**(1.0/3.0) !
	end function f

view raw cube_eqn_solve.f95 hosted with ❤ by GitHub

27. Generating Fibonacci Number

	program fibonacci
	implicit none
	integer :: n, limit, fib1, fib2, next_term
	! Read the limit for the Fibonacci sequence
	print *, "Enter the limit for Fibonacci sequence:"
	read(*, *) limit
	! Initialize the first two Fibonacci numbers
	fib1 = 0
	fib2 = 1
	! Print the first two Fibonacci numbers
	print *, fib1
	print *, fib2
	! Generate and print Fibonacci numbers up to the limit
	do n = 3, limit
	next_term = fib1 + fib2
	print *, next_term
	fib1 = fib2
	fib2 = next_term
	end do
	end program fibonacci

view raw fib.f95 hosted with ❤ by GitHub

28.EULER'S METHOD TO SOLVING A DIFFERENTIAL EQUATION BY NUMERICAL METHOD where $\frac{dy}{dx} = \frac{1}{2} (y^3 - \frac{y}{x})$ given y(1) = 1 and solve for x = 1.6 .

	!EULER METHOD TO SOLVE A DIFFERENTIAL EQUATION
	!PROBLEM::SOLVE NUMERICALLY THE DIFFERENTIAL EQUATION dy/dx=1/2(y^3-y/x) using Euler's method at x=1.6,given that y=1 when x=1
	!Also find the exact value at x=1.6
	PROGRAM EULER_METHOD
	IMPLICIT NONE
	INTEGER::I,J,N,OK
	REAL::F,X0,Y0,H,XF
	REAL,ALLOCATABLE::X(:),Y(:)
	PRINT*,"ENTER THE INITIAL VALUE OF X AND Y"
	READ*,X0,Y0
	PRINT *,X0,Y0
	PRINT *,"ENTER THE VALUE OF X WHERE THE SOLUTION WILL FIND"
	READ*,XF
	PRINT*,"ENTER THE VALUE OF H"
	READ*,H
	N= (XF-X0)/H
	ALLOCATE(X(N+1),Y(N+1),STAT=OK)
	X(1)=X0
	Y(1)=Y0
	IF(OK == 0)THEN
	DO I=1,N+1
	X(I+1)=X(I)+H
	Y(I+1)=Y(I)+H*F(X(I),Y(I))
	END DO
	ELSE
	PRINT*,"ALLOCATION FAILURE"
	ENDIF
	PRINT *,"THE SOLUTION :"
	PRINT 10,X(N+1)
	10 FORMAT(2X,"X=",F4.1)
	PRINT 20,Y(N+1)
	20 FORMAT(2X,"Y=",F7.4)
	END PROGRAM EULER_METHOD
	FUNCTION F(X,Y)
	IMPLICIT NONE
	REAL,INTENT(IN)::X,Y
	REAL::F
	F=0.5*(Y**3-Y/X)
	END FUNCTION F

view raw euler_method_diff_eqn_solve.f95 hosted with ❤ by GitHub

29. Runge Kutta Method to solve differential equation by numerical method. $\frac{dy}{dx} = y-x$ solve y(0.1) and y(0.2) where y(0) = 2

	!RUNGE-KUTTA METHOD
	!PROBLEM::Given dy/dx=y-x,y(0)=2.Find y(0.1) and y(0.2) using second order Runge-Kutta method
	PROGRAM RUNGE_KUTTA_2ND_ORDER
	IMPLICIT NONE
	INTEGER::I,J,N,OK
	REAL::X0,Y0,H,XF,F
	REAL,ALLOCATABLE::X(:),Y(:)
	PRINT*,"ENTER THE INITIAL VALUE OF X AND Y"
	READ*,X0,Y0
	PRINT*,"ENTER THE DIVISION VALUE I.E H"
	READ*,H
	PRINT*,"ENTER THE VALUE OF X WHERE THE SOLUTION BE FINDING"
	READ*,XF
	N= (XF-X0)/H
	ALLOCATE(X(N+1),Y(N+1),STAT=OK)
	X(1)=X0
	Y(1)=Y0
	DO I=1,N+1
	X(I+1) = X(I)+H
	Y(I+1) =Y(I)+0.5*H* (F(X(I),Y(I)) + F( X(I)+H , Y(I)+H*F(X(I),Y(I)) ))
	END DO
	PRINT*,"X=",X(N+1),"Y=",Y(N+1)
	END PROGRAM RUNGE_KUTTA_2ND_ORDER
	FUNCTION F(X,Y)
	IMPLICIT NONE
	REAL,INTENT(IN)::X,Y
	REAL :: F
	F= Y-X
	END FUNCTION F

view raw runge_kutta_2nd.f95 hosted with ❤ by GitHub

There has lot of code remainig to be added.

I will add soon or check out this blog.