├── README.md ├── 09. Sum Digit.f08 ├── 04. Read Write File.f08 ├── 03. Random Average.f08 ├── 05. Average From File.f08 ├── 08. Prime Check.f08 ├── 06. Odd Even.f08 ├── 10. toBase.f08 ├── 29. Matrix Transpose.f08 ├── 28. Matrix Addition.f08 ├── 02. Check Class.f08 ├── 23. Monte Carlo 2D.f08 ├── 07. CoPrime.f08 ├── LICENSE ├── 01. Quadratic Equation.f08 ├── 11. Big Small Search.f08 ├── 19. Newton Ralphson Root.f08 ├── 18. BiSection Method.f08 ├── 24. Monte Carlo 3D.f08 ├── 12. Bubble Sort.f08 ├── 21. Trapezoidal Integration.f08 ├── 22. Simpson 1-3rd Rule.f08 ├── 17. Lagrange Interpolation.f08 ├── 25. Runge Kutta Order 2.f08 ├── 20. Secant Method.f08 ├── 26. Range Kutta Order 4.f08 ├── 27. Runge Kutta SODE.f08 ├── 30. Matrix Multiplication.f08 ├── 16. Newton General Difference Formula.f08 ├── 33. Matrix Eigen Value.f08 ├── 15. Newton Forward Difference Interpolation.f08 ├── 14. Newton Backward Difference Formula.f08 ├── 13. Create Difference Table.f08 ├── 31. Gauss Elimination.f08 ├── 32. Gauss Jordan Elimination.f08 └── 34. Schrodinger Equation.f08 /README.md: -------------------------------------------------------------------------------- 1 | ![Fortran](https://img.shields.io/badge/Fortran-%23734F96.svg?style=for-the-badge&logo=fortran&logoColor=white) 2 | ![Physics](https://img.shields.io/badge/physics-%23013243.svg?style=for-the-badge&logo=numpy&logoColor=white) 3 | 4 | # Computational Physics Course Work in Fortran 5 | 6 | This includes various Approximation Algorithms implemented in Fortran 2008 as part of my curriculum. 7 | -------------------------------------------------------------------------------- /09. Sum Digit.f08: -------------------------------------------------------------------------------- 1 | ! File: Sum Digit.f08 2 | ! Author: Aakash Gajjar 3 | ! Created on July 26, 2016, 2:28 PM 4 | ! 5 | ! Subject: This programs sums individual 6 | ! digits composing that number 7 | ! 8 | 9 | program sumDigits 10 | implicit none 11 | integer :: number, sum = 0 12 | print *, "Enter a number:" 13 | read *, number 14 | do while (number > 0) 15 | sum = sum + mod(number, 10) 16 | print *, number, mod(number, 10), sum 17 | number = number/10 18 | enddo 19 | call system("pause") 20 | end program sumDigits -------------------------------------------------------------------------------- /04. Read Write File.f08: -------------------------------------------------------------------------------- 1 | ! File: Read Write File.f08 2 | ! Author: Aakash Gajjar 3 | ! Created on July 19, 2016, 2:24 PM 4 | ! 5 | ! Subject: Write into a file and reads the same 6 | ! 7 | 8 | program rwfile 9 | implicit none 10 | integer :: i 11 | open (unit = 13, file = "input", & 12 | status = "new", action = "write", iostat = i) 13 | if (i /= 0) then 14 | print *, "Error Opening file" 15 | stop 16 | endif 17 | do i = 1, 10 18 | write (unit = 13, fmt = *), i, i * i 19 | enddo 20 | close(unit = 13) 21 | end program rwfile -------------------------------------------------------------------------------- /03. Random Average.f08: -------------------------------------------------------------------------------- 1 | ! File: Random Average.f08 2 | ! Author: Aakash Gajjar 3 | ! Created on July 19, 2016, 2:25 PM 4 | ! 5 | ! Subject: Finds average of 100 numbers 6 | ! 7 | 8 | program randAVG 9 | implicit none 10 | real :: number, average = 0.0 11 | integer :: i,N 12 | call system("cls") 13 | print *,"Enter how many?" 14 | read *, N 15 | print *," Number Average" 16 | do i = 1, N 17 | number = rand() * 1000 18 | average = average + number/i 19 | print *, number, average 20 | enddo 21 | call system("pause") 22 | end program randAVG 23 | 24 | ! OUTPUT 25 | ! Enter how many? 26 | ! 3 27 | ! Number Average 28 | ! 7.62939453E-03 7.62939453E-03 29 | ! 131.537674 65.7764664 30 | ! 755.605225 317.644867 -------------------------------------------------------------------------------- /05. Average From File.f08: -------------------------------------------------------------------------------- 1 | ! File: Average From File.f08 2 | ! Author: Aakash Gajjar 3 | ! Created on October 13, 2016, 2:26 PM 4 | ! 5 | ! Subject: This program writes 100 random float 6 | ! numbers to a file and then closes the file. 7 | ! Then again it opens the same file and reads those 8 | ! numbers and prints them. 9 | ! THE FILE NAME is 'average' 10 | 11 | program calculateAverage 12 | implicit none 13 | integer :: error, i 14 | integer :: length 15 | real :: j 16 | length = 100 17 | ! This line opens a new file 18 | open(23, file = "average") 19 | do i = 1, length 20 | write(23,*) rand()*100 21 | end do 22 | rewind(23) 23 | do i = 1, length 24 | read(23,*) j 25 | print *, j 26 | end do 27 | close(23) 28 | end program calculateAverage -------------------------------------------------------------------------------- /08. Prime Check.f08: -------------------------------------------------------------------------------- 1 | ! File: Prime Check.f08 2 | ! Author: Aakash Gajjar 3 | ! Created on August 02, 2016, 2:37 PM 4 | ! 5 | ! Subject: Checks if two numbers are 6 | ! prime or not! using modulo 7 | ! 8 | 9 | program checkPrime 10 | implicit none 11 | integer :: number, i, maxNum 12 | do while (.true.) 13 | print *, "Enter a number" 14 | read *, number 15 | maxNum = number/2 16 | i = 2 17 | do while (i <= maxNum) 18 | if (mod(number, i) == 0) then 19 | print *, number, "is Not a prime" 20 | exit 21 | endif 22 | i = i + 1 23 | enddo 24 | if (i > maxNum) then 25 | print *, number, "is a Prime number" 26 | endif 27 | enddo 28 | end program checkPrime 29 | 30 | ! OUTPUT 31 | ! Enter a number 32 | ! 23 33 | ! 23 is a Prime number -------------------------------------------------------------------------------- /06. Odd Even.f08: -------------------------------------------------------------------------------- 1 | ! File: Odd Even.f08 2 | ! Author: Aakash Gajjar 3 | ! Created on July 13, 2016, 2:19 PM 4 | ! 5 | ! Check whether a number is odd or even 6 | ! It determines by taking a modulo 2 7 | ! and checking a remainder returned 8 | ! 9 | 10 | program evenODD 11 | implicit none 12 | integer :: inputNumber 13 | print *, "Enter Ctrl-C to exit" 14 | do while (.true.) 15 | print *, "Enter a number:" 16 | read *, inputNumber 17 | if (mod(inputNumber, 2) == 0) then 18 | print *, inputNumber, " is was EVEN!" 19 | else 20 | print *, inputNumber, " is was ODD!" 21 | endif 22 | enddo 23 | end program evenODD 24 | 25 | ! OUTPUT 26 | ! Enter Ctrl-C to exit 27 | ! Enter a number: 28 | ! 3 29 | ! 3 is ODD! 30 | ! Enter a number: 31 | ! 6 32 | ! 6 is EVEN! -------------------------------------------------------------------------------- /10. toBase.f08: -------------------------------------------------------------------------------- 1 | ! File: toBase.f08 2 | ! Author: Aakash Gajjar 3 | ! Created on August 02, 2016, 2:39 PM 4 | ! 5 | ! Subject: This program converts a given 6 | ! decimal number into specified base system 7 | ! 8 | 9 | program toBinary 10 | implicit none 11 | integer :: number = 17 12 | integer :: base = 16 13 | print *, "Enter number" 14 | read *, number 15 | ! Specify base here 16 | print *, "Enter base to convert in" 17 | read *,base 18 | print *,"read from right to left" 19 | do while (number >= base) 20 | write(*, '(i0)',advance='no') mod(number, base) 21 | number = number/base 22 | enddo 23 | write(*, '(i0)',advance='no') number 24 | end program toBinary 25 | 26 | ! OUTPUT 27 | ! Enter number 28 | ! 2 29 | ! Enter base to convert in 30 | ! 2 31 | ! read from right to left 32 | ! 01 -------------------------------------------------------------------------------- /29. Matrix Transpose.f08: -------------------------------------------------------------------------------- 1 | ! File: Matrix Transpose.f08 2 | ! Author: Aakash Gajjar 3 | ! Created on July 27, 2016, 2:31 PM 4 | ! 5 | ! Subject: This program finds transpose 6 | ! of a given matrix and prints it 7 | ! 8 | 9 | program transposeMatrix 10 | implicit none 11 | integer :: dim = 5, temp 12 | integer, dimension(5, 5) :: A 13 | integer :: row, col 14 | 15 | ! initialize MAtrix 16 | do col = 1, dim 17 | do row = 1, dim 18 | A(row, col) = rand() * 1000 19 | enddo 20 | enddo 21 | 22 | ! Do Transpose 23 | do col = 1, dim 24 | do row = 1, dim 25 | temp = A(row, col) 26 | A(row, col) = A(col, row) 27 | A(col, row) = temp 28 | enddo 29 | enddo 30 | 31 | ! print matrix 32 | do col = 1, dim 33 | do row = 1, dim 34 | write(*, '(i5)') A(row, col) 35 | enddo 36 | enddo 37 | end program transposeMatrix -------------------------------------------------------------------------------- /28. Matrix Addition.f08: -------------------------------------------------------------------------------- 1 | ! File: Matrix Addition.f08 2 | ! Author: Aakash Gajjar 3 | ! Created on July 27, 2016, 2:30 PM 4 | ! 5 | ! Subject: This program adds two matrix of 6 | ! same (rows,cols). 7 | ! 8 | 9 | program addMatrix 10 | implicit none 11 | integer, dimension(5, 5) :: A, B 12 | integer :: row, col, dim = 5 13 | 14 | ! initialize MAtrix 15 | do col = 1, dim 16 | do row = 1, dim 17 | A(row, col) = rand() * 1000 18 | B(row, col) = rand() * 1000 * 2 19 | enddo 20 | enddo 21 | 22 | ! add MAtrix 23 | do col = 1, dim 24 | do row = 1, dim 25 | B(row, col) = B(row, col) + A(row, col) 26 | enddo 27 | enddo 28 | 29 | ! print MAtrix 30 | print *, "After adding two MAtrix" 31 | do row = 1, dim 32 | do col = 1, dim 33 | write (*, '(i5)', advance = 'no') B(row, col) 34 | enddo 35 | enddo 36 | end program addMatrix -------------------------------------------------------------------------------- /02. Check Class.f08: -------------------------------------------------------------------------------- 1 | ! File: Check Class.f08 2 | ! Author: Aakash Gajjar 3 | ! Created on July 13, 2016, 2:21 PM 4 | ! 5 | ! Subject: Calculate Percentage and outputs 6 | ! the corresponding class 7 | ! First Class: >=60 8 | ! Second Class: 40<=x<60 9 | ! Fail: <40 10 | ! Allowed No of Subject: 3 11 | ! 12 | 13 | program calculatePercentage 14 | implicit none 15 | integer :: sub1, sub2, sub3 16 | real :: percentage 17 | do while (.true.) 18 | print *, "Enter 3 Subjects Marks (out of 100)" 19 | read *, sub1, sub2, sub3 20 | percentage = (sub1 + sub2 + sub3)/3 21 | if (percentage >= 60) then 22 | print *, "First Class" 23 | else if (percentage >= 40 .and. percentage < 60) then 24 | print *, "Second Class" 25 | else 26 | print *, "Failed" 27 | endif 28 | enddo 29 | end program calculatePercentage 30 | 31 | ! OUTPUT 32 | ! Enter 3 Subjects Marks (out of 100) 33 | ! 50 50 50 34 | ! Second Class 35 | -------------------------------------------------------------------------------- /23. Monte Carlo 2D.f08: -------------------------------------------------------------------------------- 1 | ! File: Monte Carlo 2D.f08 2 | ! Author: Aakash Gajjar 3 | ! Created on August 07, 2016, 2:48 PM 4 | ! 5 | ! Subject: Implementing Monte Carlo 1D Integration 6 | ! for simple function y = x from [0,1] 7 | ! 8 | 9 | function func(point) 10 | implicit none 11 | real :: func, point 12 | func = point 13 | end function 14 | 15 | function MC_1D(samples, low, high) 16 | implicit none 17 | real :: low, high, func, answer = 0, MC_1D 18 | integer :: samples, i 19 | 20 | do i = 1, samples 21 | answer = answer + func(low + (high - low) * rand()) 22 | enddo 23 | MC_1D = answer/samples; 24 | end function 25 | 26 | program main 27 | implicit none 28 | real :: answer, MC_1D 29 | integer :: samples 30 | print *, "In 1000 iteration", MC_1D(1000, 0.0, 1.0) 31 | print *, "Analytic answer is 0.5" 32 | end program 33 | 34 | ! OUTPUT 35 | ! In 1000 iteration 0.497961760 36 | ! Analytic answer is 0.5 -------------------------------------------------------------------------------- /07. CoPrime.f08: -------------------------------------------------------------------------------- 1 | ! File: CoPrime.f08 2 | ! Author: Aakash Gajjar 3 | ! Created on August 02, 2016, 2:38 PM 4 | ! 5 | ! Subject: This program checks whether two 6 | ! numbers are co-prime or not 7 | ! Two numbers are co-prime if their GCD is 1 8 | ! 9 | 10 | program coPrime 11 | implicit none 12 | integer :: number1 = 12, number2 = 11, i, temp, isCoPrime = 1 13 | print *, "Enter Two Numbers" 14 | read *, number1, number2 15 | ! Swap Numbers if Number1 is less, Number2 is Bigger 16 | if (number1 > number2) then 17 | temp = number1 18 | number1 = number2 19 | number2 = temp 20 | endif 21 | ! Start the real thing 22 | i = 2 23 | do while (i < number1) 24 | if (mod(number1, i) == 0) then 25 | if (mod(number2, i) == 0) then 26 | isCoPrime = 0 27 | endif 28 | endif 29 | i = i + 1 30 | enddo 31 | if (isCoPrime == 1) then 32 | print *, "They are co-prime" 33 | else 34 | print *, "They are No a co-prime" 35 | endif 36 | end program coPrime 37 | 38 | ! OUTPUT 39 | ! Enter Two Numbers 40 | ! 23 12 41 | ! They are co-prime 42 | ! Enter Two Numbers 43 | ! 4 12 44 | ! They are No a co-prime -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2017-2022, Aakash Gajjar 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /01. Quadratic Equation.f08: -------------------------------------------------------------------------------- 1 | ! File: Quadratic Equation.f08 2 | ! Author: Aakash Gajjar 3 | ! Created on October 13, 2016, 2:15 PM 4 | ! 5 | ! Subject: Finds solution of quadratic 6 | ! equation 7 | 8 | function solve2D(A, B, C, root1, root2) 9 | implicit none 10 | real :: solve2D, delta, uRoot 11 | real, intent(out) :: root1, root2 12 | integer, intent(in) :: A, B, C 13 | uRoot = B * B - 4 * A * C 14 | if (uRoot < 0) then 15 | delta = sqrt((-1.) * uRoot) 16 | else 17 | delta = sqrt((1.) * uRoot) 18 | endif 19 | root1 = ((-1) * B + delta)/(2 * A) 20 | root2 = ((-1) * B - delta)/(2 * A) 21 | solve2D = 0 22 | end function solve2D 23 | 24 | program quadratic 25 | implicit none 26 | integer :: A, B, C, out 27 | real :: solve2D, root1 = 0., root2 = 0. 28 | print *, "Enter Coefficients of X^2, X and Constant" 29 | read *, A, B, C 30 | out = solve2D(A, B, C, root1, root2) 31 | print "(a,i1,a,i1,a,i1,a,f9.5,a,f9.5)", "Equation: ", & 32 | A, "x^2+", B, "x+", C, " has two roots ", root1, " &", root2 33 | end program quadratic 34 | 35 | ! OUTPUT 36 | ! Enter Coefficients of X^2, X and Constant 37 | ! 1 2 3 38 | ! Equation: 1x^2+2x+3 has two roots 0.41421 & -2.41421 -------------------------------------------------------------------------------- /11. Big Small Search.f08: -------------------------------------------------------------------------------- 1 | ! File: Big Small Search.f08 2 | ! Author: Aakash Gajjar 3 | ! Created on July 27, 2016, 2:33 PM 4 | ! 5 | ! Subject: This program finds smallest and biggest 6 | ! numbers in a list of numbers 7 | ! and compares the result with fortran intrinsic 8 | ! functions 9 | ! 10 | 11 | program smallBig 12 | implicit none 13 | integer :: length = 10 14 | integer, dimension(10) :: A 15 | integer :: row, smallest = 100000000, biggest = 0, temp 16 | 17 | ! initialize array 18 | do row = 1, length 19 | A(row) = 11 * rand() 20 | enddo 21 | 22 | ! find numbers 23 | do row = 1, length 24 | if (A(row) > biggest) then 25 | biggest = A(row) 26 | endif 27 | if (A(row) < smallest) then 28 | smallest = A(row) 29 | endif 30 | enddo 31 | 32 | ! print array 33 | do row = 1, length 34 | write (*, '(i3)', advance = 'no') A(row) 35 | enddo 36 | print *, '' 37 | write(*, fmt = *) "Smallest:", smallest, "Biggest:", biggest 38 | write(*, fmt = *) "Using inbuilt function Smallest:", & 39 | minval(A), "Biggest:", maxval(A) 40 | call system('pause') 41 | end program smallBig 42 | 43 | ! OUTPUT 44 | ! 0 1 8 5 5 2 0 7 7 10 45 | ! Smallest: 0 Biggest: 10 46 | ! Using inbuilt functions Smallest: 0 Biggest: 10 -------------------------------------------------------------------------------- /19. Newton Ralphson Root.f08: -------------------------------------------------------------------------------- 1 | ! File: Newton Ralphson Root.f08 2 | ! Author: Aakash Gajjar 3 | ! Created on August 26, 2016, 9:01 PM 4 | ! 5 | ! Subject: Implementation of Newton Ralphson 6 | ! root finding procedure 7 | ! This method explicitly requires to define function 8 | ! as well as it's first derivative 9 | ! 10 | 11 | ! The FUNCTION 12 | function f(x) 13 | implicit none 14 | real :: f, x 15 | f = x * x - 25.0 16 | end function 17 | 18 | ! The FUNCTION'S DERIVATIVE 19 | function fD(x) 20 | implicit none 21 | real :: fD, x 22 | fD = 2.0 * x 23 | end function fD 24 | 25 | function NR(guess, tolerance) 26 | implicit none 27 | real :: NR, guess, tolerance 28 | real :: f, fD 29 | 30 | NR = guess 31 | ! Don't forget as we get close to a 32 | ! root the function value converges 33 | ! to zero(0). 34 | do while (abs(f(NR)) > tolerance) 35 | NR = NR - (f(NR)/fD(NR)) 36 | end do 37 | 38 | end function NR 39 | 40 | ! Note: Compare this result from BiSection Method 41 | ! You should see that this method gives root 42 | ! 5.0000 to be exact where BiSection does not! 43 | ! 44 | program NewtonRalphson 45 | implicit none 46 | real :: NR 47 | print *, NR(1.0, 1.0e-7) 48 | end program NewtonRalphson 49 | 50 | ! OOUPUT 51 | ! 5.00000000 -------------------------------------------------------------------------------- /18. BiSection Method.f08: -------------------------------------------------------------------------------- 1 | ! File: BiSection Method.f08 2 | ! Author: Aakash Gajjar 3 | ! Created on August 26, 2016, 8:33 PM 4 | ! 5 | ! Subject: Implementation BiSection Method 6 | ! to find root of 1D equation in 7 | ! a given interval 8 | ! 9 | 10 | ! The FUNCTION whose root we want 11 | ! to find 12 | function f(x) 13 | implicit none 14 | real :: f,x 15 | f = x*x-25.0 16 | end function f 17 | 18 | ! See the Reference given 19 | function BiSection(a,b) 20 | implicit none 21 | real :: BiSection,a,b 22 | real :: f 23 | real :: low,high,middle 24 | ! Maximum Tolerance 25 | real :: tolerance = 1.0e-6 26 | 27 | ! Choose low and high interval 28 | ! value 29 | low = a 30 | high = b 31 | do while(abs(high-low)>tolerance) 32 | ! Find mid point and compare 33 | middle = low + (high-low)/2 34 | ! Swap whoever is more 35 | if (f(low)*f(middle)>0) then 36 | low = middle 37 | else 38 | high = middle 39 | endif 40 | end do 41 | 42 | ! Increases Significance just by 43 | ! taking mid for one more time 44 | BiSection = low + (high-low)/2 45 | 46 | end function BiSection 47 | 48 | ! The main program container 49 | program BiSectionMethod 50 | implicit none 51 | real :: BiSection 52 | print *,BiSection(0.0,10.0) 53 | end program BiSectionMethod 54 | 55 | ! OUTPUT 56 | ! 4.99999952 -------------------------------------------------------------------------------- /24. Monte Carlo 3D.f08: -------------------------------------------------------------------------------- 1 | ! File: Monte Carlo 1D.f08 2 | ! Author: Aakash Gajjar 3 | ! Created on August 07, 2016, 2:45 PM 4 | ! 5 | ! Subject: Implementing Monte Carlo 3D Integration 6 | ! for simple function xyz from [0,1],[0,1],[0,1] 7 | ! Ans = 1/8 = 0.125 8 | ! 9 | 10 | function func(x, y, z) 11 | implicit none 12 | real :: func, x, y, z 13 | func = x * y * z 14 | end function 15 | 16 | function MC_1D(samples, lowx, highx, lowy, highy, lowz, highz) 17 | implicit none 18 | real :: MC_1D, func 19 | real :: lowx, highx, lowy, highy, lowz, highz 20 | real :: answer = 0.0 21 | integer :: samples, i 22 | 23 | do i = 1, samples 24 | answer = answer + func(lowx + (highx - lowx) * rand(), & 25 | lowy + (highy - lowy) * rand(), lowz + (highz - lowz) * rand()) 26 | enddo 27 | MC_1D = answer/samples 28 | end function 29 | 30 | program main 31 | implicit none 32 | real :: answer, MC_1D, lowx = 0.0, highx = 1 33 | real :: lowy = 0.0, highy = 1, lowz = 0, highz = 1 34 | integer :: samples = 1000000 35 | print *, "Analytical Value : 0.125" 36 | print *, "Approx Value: ", MC_1D(samples, lowx, highx, lowy, & 37 | highy, lowy, highy), " after ", samples, " steps" 38 | end program 39 | 40 | ! OUTPUT 41 | ! Analytical Value : 0.125 42 | ! Approx Value: 0.125147223 after 1000000 steps -------------------------------------------------------------------------------- /12. Bubble Sort.f08: -------------------------------------------------------------------------------- 1 | ! File: Bubble Sort.f08 2 | ! Author: Aakash Gajjar 3 | ! Created on July 27, 2016, 2:35 PM 4 | ! 5 | ! Subject: This program sorts given list of 6 | ! numbers using a very simple sorting algorithm 7 | ! known as "Bubble Sort" 8 | ! In bubble sort we swap two consecutive numbers 9 | ! until they are sorted in a ascending or 10 | ! descending order. 11 | ! 12 | 13 | program bubbleSort 14 | implicit none 15 | integer :: length = 10 16 | integer, dimension(10) :: A 17 | integer :: row, col, temp 18 | 19 | ! initialize matrix 20 | do row = 1, length 21 | A(row) = 10 * rand() 22 | enddo 23 | 24 | ! print sorted array 25 | print *, "Unsorted: " 26 | do row = 1, length 27 | write(*, '(i4)', advance = 'no') A(row) 28 | enddo 29 | print *, "" 30 | 31 | ! bubble sorting algorithms 32 | do row = 1, length 33 | do col = row, length 34 | if (A(col) < A(row)) then 35 | temp = A(row) 36 | A(row) = A(col) 37 | A(col) = temp 38 | endif 39 | enddo 40 | enddo 41 | 42 | ! print sorted array 43 | print *, "Sorted: " 44 | do row = 1, length 45 | write(*, '(i4)', advance = 'no') A(row) 46 | enddo 47 | print *, '' 48 | call system('pause') 49 | end program bubbleSort 50 | 51 | ! OUTPUT 52 | ! Unsorted: 53 | ! 0 1 7 4 5 2 0 6 6 9 54 | ! Sorted: 55 | ! 0 0 1 2 4 5 6 6 7 9 -------------------------------------------------------------------------------- /21. Trapezoidal Integration.f08: -------------------------------------------------------------------------------- 1 | ! File: Trapezoidal Integration.f08 2 | ! Author: Aakash Gajjar 3 | ! Created on August 26, 2016, 6:15 PM 4 | ! 5 | ! Subject: Implementation of Trapezoidal 6 | ! integration procedure 7 | ! 8 | 9 | 10 | ! This is a utility function that calculates 11 | ! X^Y, x to the power y 12 | function pow(base, power) 13 | implicit none 14 | real :: pow, base 15 | integer :: power, i 16 | pow = 1.0 17 | do i = 1, power 18 | pow = pow * base 19 | end do 20 | end function pow 21 | 22 | ! The function which we want to integrate 23 | function f(x) 24 | implicit none 25 | real :: f, x, pow 26 | f = 0.2 + 25 * pow(x, 1) & 27 | -200 * pow(x, 2) & 28 | +675 * pow(x, 3) & 29 | -900 * pow(x, 4) & 30 | +400 * pow(x, 5) 31 | end function 32 | 33 | ! The Trapezoidal Function 34 | function trapezoidal(low, high, steps) 35 | implicit none 36 | real :: trapezoidal, low, high, f 37 | integer :: steps 38 | real :: stepSize 39 | real :: answer 40 | integer :: i 41 | 42 | stepSize = (high - low)/steps 43 | 44 | ! YOU should check definition for 45 | ! this method 46 | answer = f(low) + f(high) 47 | 48 | ! i is from 1 to less than steps 49 | do i = 1, steps - 1 50 | answer = answer + 2 * f(low + i * stepSize) 51 | end do 52 | 53 | trapezoidal = answer * stepSize/2 54 | end function trapezoidal 55 | 56 | program TrapezoidalLaw 57 | implicit none 58 | real :: trapezoidal 59 | !Exact value is 1.640533 60 | print *, trapezoidal(0.0, 0.8, 200) 61 | end program TrapezoidalLaw 62 | 63 | ! OUTPUT 64 | ! 1.64046979 -------------------------------------------------------------------------------- /22. Simpson 1-3rd Rule.f08: -------------------------------------------------------------------------------- 1 | ! File: Simpson 1-3rd Rule.f08 2 | ! Author: Aakash Gajjar 3 | ! Created on August 26, 2016, 6:28 PM 4 | ! 5 | ! Subject: Implementation of Simpson's 6 | ! One third integration rule 7 | ! to integrate a given function 8 | ! between specified interval 9 | ! 10 | 11 | ! This is a utility function that calculates 12 | ! X^Y, x to the power y 13 | function pow(base, power) 14 | implicit none 15 | real :: pow, base 16 | integer :: power, i 17 | pow = 1.0 18 | do i = 1, power 19 | pow = pow * base 20 | end do 21 | end function pow 22 | 23 | ! The function which we want to integrate 24 | function f(x) 25 | implicit none 26 | real :: f, x, pow 27 | f = 0.2 + 25 * pow(x, 1) & 28 | -200 * pow(x, 2) & 29 | +675 * pow(x, 3) & 30 | -900 * pow(x, 4) & 31 | +400 * pow(x, 5) 32 | end function 33 | 34 | ! The Simpson's One Third Rule 35 | ! Procedure 36 | function S13(low, high, steps) 37 | implicit none 38 | real :: S13, low, high, f 39 | integer :: steps 40 | real :: stepSize, a, b, c 41 | integer :: i 42 | 43 | ! Steps should be even 44 | stepSize = (high - low)/(2 * steps) 45 | S13 = 0.0 46 | 47 | ! This loop calculates rectangles area 48 | ! as a,b,c and uses those to estimate 49 | ! area S13 50 | do i = 1, steps 51 | a = low + (2 * i - 2) * stepSize 52 | b = low + (2 * i - 1) * stepSize 53 | c = low + (2 * i - 0) * stepSize 54 | S13 = S13 + (f(a) + f(c) + 4.0 * f(b)) 55 | end do 56 | 57 | S13 = S13 * stepSize/3.0 58 | 59 | end function S13 60 | 61 | ! The main container program 62 | program Simpson1_3Rule 63 | implicit none 64 | real :: S13 65 | !Exact value is 1.640533 66 | print *, S13(0.0, 0.8, 200) 67 | end program Simpson1_3Rule 68 | 69 | ! OUTPUT 70 | ! 1.64053357 -------------------------------------------------------------------------------- /17. Lagrange Interpolation.f08: -------------------------------------------------------------------------------- 1 | ! File: Lagrange Interpolation.f08 2 | ! Author: Aakash Gajjar 3 | ! Created on August 26, 2016, 11:12 PM 4 | ! 5 | ! Subject: Implementation of Lagrange 6 | ! Interpolation Formula 7 | ! 8 | ! Note: The Implementation should be self explaining 9 | 10 | ! This function finds factor for L's Polynomial 11 | function factor(size, point, x, order) 12 | implicit none 13 | real :: factor, point 14 | integer :: size, order 15 | real, dimension(size) :: x 16 | integer :: i 17 | 18 | ! If YOU're still confuse check the formula first 19 | factor = 1.0 20 | do i = 1, size 21 | if (i /= order) then 22 | factor = factor * (point - x(i))/(x(order) - x(i)) 23 | end if 24 | end do 25 | 26 | end function factor 27 | 28 | ! The main function for Interpolation 29 | function lagrange(size, point, x, f) 30 | implicit none 31 | integer :: size 32 | real :: lagrange, point, factor 33 | real, dimension(size) :: x, f 34 | integer :: i 35 | 36 | ! The lagrange polynomial 37 | ! Initialized with 0 38 | lagrange = 0.0 39 | do i = 1, size 40 | ! We want to sum with the factor of degree i 41 | ! into function i.e. lagrange 42 | lagrange = lagrange + factor(size, point, x, i) * f(i) 43 | end do 44 | 45 | end function lagrange 46 | 47 | ! Main program container 48 | program LagrangeInterpolation 49 | implicit none 50 | real :: lagrange, point = 1.83 51 | integer :: size = 5, i 52 | real, dimension(5) :: x, f 53 | ! Function data 54 | f = (/0.0, 1.0986, 1.6094, 1.9459, 2.1972/) 55 | ! The variable X data 56 | x = (/1.0, 3.0, 5.0, 7.0, 9.0/) 57 | ! Prints Interpolated Value 58 | print *, lagrange(size, point, x, f) 59 | end program LagrangeInterpolation 60 | 61 | ! OUTPUT 62 | ! Function data 63 | ! f = 0.0, 1.0986, 1.6094, 1.9459, 2.1972 64 | ! Variable X data 65 | ! x = 1.0, 3.0, 5.0, 7.0, 9.0 66 | ! x = 1.83 67 | ! f = 0.567234635 -------------------------------------------------------------------------------- /25. Runge Kutta Order 2.f08: -------------------------------------------------------------------------------- 1 | ! File: Runge-Kutta Order 2.f08 2 | ! Author: Aakash Gajjar 3 | ! Created on September 2, 2016, 10:44 PM 4 | ! 5 | ! Subject: Implementation of Runge-Kutta Second 6 | ! Order Method to solve ODE's of the 7 | ! order 1. 8 | 9 | ! This is the function 10 | ! of kind y' = f(x,y) 11 | function f(x, y) 12 | implicit none 13 | real :: f 14 | real :: x, y 15 | f = 3.0 * x + y/2.0 16 | end function f 17 | 18 | ! RK2 Subroutine that takes following arguments 19 | ! steps: Number of steps 20 | ! low: Low Bound of X value 21 | ! high: Upper Bound of Y value 22 | ! x0: Initial value of x 23 | ! y0: Initial value of y 24 | ! y: Output Value 25 | subroutine RKTwo(steps, low, high, x0, y0, y) 26 | implicit none 27 | real :: f 28 | integer, intent(in) :: steps 29 | real, intent(in) :: low, high 30 | real, intent(in) :: x0, y0 31 | real(kind = 8), intent(out) :: y 32 | real :: lastX, lastY 33 | real :: stepSize 34 | real :: k1, k2 35 | integer :: i 36 | 37 | ! Calculates stepSize according to supplied 38 | ! number of steps 39 | stepSize = (high - low)/steps 40 | lastX = x0 41 | lastY = y0 42 | do i = 1, steps 43 | ! Increase the value since we already have 44 | ! initial value 45 | lastX = lastX + stepSize 46 | ! Coefficients 47 | k1 = f(lastX, lastY) 48 | k2 = f(lastX + (2.0/3.0) * stepSize, lastY & 49 | +(2.0/3.0) * stepSize * k1) 50 | ! Update lastY with new value 51 | lastY = lastY + stepSize * (k1/4.0 + 3.0 * k2/4) 52 | ! Just for debugging 53 | !print *, lastX, lastY 54 | end do 55 | ! Return value 56 | y = lastY 57 | end subroutine RKTwo 58 | 59 | ! Got to have main 60 | program RK2 61 | implicit none 62 | real(kind = 8) :: y = 0 63 | ! Why don't make a call 64 | call RKTwo(100, 0.0, 0.2, 0.0, 1.0, y) 65 | ! Don't you wanna know answer 66 | print *, y 67 | print *, "Exact value is: 1.16722193" 68 | end program RK2 69 | 70 | ! OUTPUT 71 | ! 1.1684831380844116 72 | ! Exact value is: 1.16722193 -------------------------------------------------------------------------------- /20. Secant Method.f08: -------------------------------------------------------------------------------- 1 | ! File: Secant Method.f08 2 | ! Author: Aakash Gajjar 3 | ! Created on August 30, 2016, 6:48 PM 4 | ! 5 | ! Subject: Implementation of Secant Method 6 | ! that removes difficulty of finding 7 | ! derivative of function f instead it 8 | ! approximates the derivative using 9 | ! Secant's Approximation 10 | ! 11 | 12 | ! This is the function 13 | ! whose root we want to 14 | ! find! 15 | function f(x) 16 | implicit none 17 | real :: f, x 18 | f = x*x-25 19 | end function 20 | 21 | ! The Secant's Approximation 22 | ! of derivative of function f 23 | function f1(x, lastX) 24 | implicit none 25 | real :: f1, x, lastX, f 26 | f1 = (f(lastX) - f(x))/(lastX - x) 27 | if (lastX == 0) then 28 | f1 = 1.0 29 | end if 30 | end function f1 31 | 32 | ! The main Secant's Approximation 33 | ! procedure 34 | ! It requires an initial guess value 35 | ! plus lastX value i.e. x(n-1) 36 | ! guess = Initial Guess 37 | ! lastX = X(-1) value if starting from 0 38 | ! maxIter = Maximum iterations to perform 39 | ! It stops after until maxIter is 40 | ! reached or the value is below 41 | ! a fixed tolerance of 1e-6 42 | ! 43 | function SECANT(guess, lastX, maxIter) 44 | implicit none 45 | real :: SECANT 46 | real :: guess, lastX 47 | integer :: maxIter 48 | real :: f, f1 49 | integer :: i 50 | real :: last, temp 51 | 52 | ! It stores last value of x in 53 | ! variable last 54 | SECANT = guess 55 | last = lastX 56 | do i = 1, maxIter 57 | ! make decision based on tolerance 58 | ! whether to exit or continue 59 | if (abs(SECANT - last) > 1e-6) then 60 | temp = SECANT 61 | SECANT = SECANT - f(SECANT)/f1(SECANT, last) 62 | last = temp 63 | end if 64 | end do 65 | end function SECANT 66 | 67 | program SecantMethod 68 | implicit none 69 | real :: SECANT 70 | ! The root of this function is 71 | ! 0.56714329 72 | print *, SECANT(1.0, 0.0, 100) 73 | end program SecantMethod 74 | 75 | ! OUTPUT 76 | ! 5.00000000 -------------------------------------------------------------------------------- /26. Range Kutta Order 4.f08: -------------------------------------------------------------------------------- 1 | ! File: Range Kutta Order 4.f08 2 | ! Author: Aakash Gajjar 3 | ! Created on September 17, 2016, 10:34 PM 4 | ! 5 | ! Subject: Implementation of Runge-Kutta Fourth 6 | ! Order method for solving ODE's of 7 | ! order 1 8 | 9 | ! This is the function 10 | ! of kind y' = f(x,y) 11 | function f(x, y) 12 | implicit none 13 | real :: f 14 | real :: x, y 15 | f = 3.0 * x + y/2.0 16 | end function f 17 | 18 | ! RK4 Subroutine that takes following arguments 19 | ! steps: Number of steps 20 | ! low: Low Bound of X value 21 | ! high: Upper Bound of Y value 22 | ! x0: Initial value of x 23 | ! y0: Initial value of y 24 | ! y: Output Value 25 | subroutine RKFour(steps, low, high, x0, y0, y) 26 | implicit none 27 | real :: f 28 | integer, intent(in) :: steps 29 | real, intent(in) :: low, high 30 | real, intent(in) :: x0, y0 31 | real, intent(out) :: y 32 | real :: lastX, lastY 33 | real :: stepSize 34 | real :: k1, k2, k3, k4 35 | integer :: i 36 | 37 | ! Calculates stepSize according to supplied 38 | ! number of steps 39 | stepSize = (high - low)/steps 40 | lastX = x0 41 | lastY = y0 42 | do i = 1, steps 43 | ! Increase the value since we already have 44 | ! initial value 45 | lastX = lastX + stepSize 46 | ! Coefficients 47 | k1 = stepSize * f(lastX, lastY) 48 | k2 = stepSize * f(lastX + stepSize/2.0, lastY + k1/2.0) 49 | k3 = stepSize * f(lastX + stepSize/2.0, lastY + k2/2.0) 50 | k4 = stepSize * f(lastX + stepSize, lastY + k3) 51 | ! Update lastY with new value 52 | lastY = lastY + (k1 + 2 * k2 + 2 * k3 + k4)/6.0 53 | ! Just for debugging 54 | !print *, stepSize, lastX, lastY 55 | end do 56 | ! Return value 57 | y = lastY 58 | end subroutine RKFour 59 | 60 | ! Got to have main 61 | program RK4 62 | implicit none 63 | real :: y = 0.0 64 | ! Why don't make a call 65 | call RKFour(10, 0.0, 0.2, 0.0, 1.0, y) 66 | ! Don't you wanna know answer 67 | print *, y 68 | print *, "Exact value is: 1.16722193" 69 | end program RK4 70 | 71 | ! OUTPUT 72 | ! 1.17984271 73 | ! Exact value is: 1.16722193 -------------------------------------------------------------------------------- /27. Runge Kutta SODE.f08: -------------------------------------------------------------------------------- 1 | ! File: Runge Kutta SODE.f08 2 | ! Author: Aakash Gajjar 3 | ! Created on September 18, 2016, 12:20 PM 4 | ! 5 | ! Subject: Implementation of Runge-Kutta Fourth 6 | ! Order method for solving simultaneous 7 | ! ODE's of order 1 8 | ! 9 | 10 | function f(x, y1, y2) 11 | implicit none 12 | real :: f 13 | real :: x, y1, y2 14 | f = -y1/2 15 | end function f 16 | 17 | function g(x, y1, y2) 18 | implicit none 19 | real :: g 20 | real :: x, y1, y2 21 | g = 4 - 0.3 * y2 - 0.1 * y1 22 | end function g 23 | 24 | subroutine RKFour(steps, low, high, x0, y1, y2) 25 | implicit none 26 | real :: f, g 27 | integer, intent(in) :: steps 28 | real, intent(in) :: low, high 29 | real, intent(in) :: x0 30 | real, intent(in out) :: y1, y2 31 | real :: lastX, lastY 32 | real :: stepSize 33 | real :: f1, f2, f3, f0 34 | real :: g1, g2, g3, g0 35 | integer :: i 36 | 37 | ! Calculates stepSize according to supplied 38 | ! number of steps 39 | stepSize = (high - low)/steps 40 | lastX = x0 41 | !write(*, '(f9.6Af9.6Af9.6)') lastX, 9, y1, 9, y2 42 | !write(*, '(f9.6Af9.6Af9.6)') lastX, ' ', y1, ' ', y2 43 | do i = 1, steps 44 | lastX = lastX + stepSize 45 | f0 = stepSize * f(lastX, y1, y2) 46 | g0 = stepSize * g(lastX, y1, y2) 47 | 48 | f1 = stepSize * f(lastX + stepSize/2, y1 + f0/2, y2 + g0/2) 49 | g1 = stepSize * g(lastX + stepSize/2.0, y1 + f0/2.0, y2 + g0/2) 50 | 51 | f2 = stepSize * f(lastX + stepSize/2, y1 + f1/2, y2 + g1/2) 52 | g2 = stepSize * g(lastX + stepSize/2, y1 + f1/2, y2 + g1/2) 53 | 54 | f3 = stepSize * f(lastX + stepSize, y1 + f2, y2 + g2) 55 | g3 = stepSize * g(lastX + stepSize, y1 + f2, y2 + g2) 56 | 57 | y1 = y1 + (f0 + 2 * f1 + 2 * f2 + f3)/6 58 | y2 = y2 + (g0 + 2 * g1 + 2 * g2 + g3)/6 59 | !write(*, '(f9.6Af9.6Af9.6)') lastX, ' ', y1, ' ', y2 60 | end do 61 | end subroutine RKFour 62 | 63 | ! Got to have main 64 | program RK4 65 | implicit none 66 | real :: x = 0.0, y1 = 4.0, y2 = 6.0 67 | call RKFour(4, x, 2.0, x, y1, y2) 68 | ! Don't you wanna know answer 69 | print *, y1, y2 70 | end program RK4 71 | 72 | ! OUTPUT 73 | ! 1.47157681 8.94686508 -------------------------------------------------------------------------------- /30. Matrix Multiplication.f08: -------------------------------------------------------------------------------- 1 | ! File: Matrix Multiplication.f08 2 | ! Author: Aakash Gajjar 3 | ! Created on August 30, 2016, 8:29 PM 4 | ! 5 | ! Subject: Implementation of Matrix 6 | ! Multiplication using 7 | ! Fortran Subroutines 8 | ! 9 | 10 | ! Multiplies two matrix 11 | ! Matrix-1: a of dim: n,m in 12 | ! Matrix-2: b of dim: m,l in 13 | ! Matrix-3: b of dim: n,l out 14 | subroutine MatrixAB(a, b, c, n, m, l) 15 | integer :: n, m, l 16 | real, intent(in out), dimension(n, m) :: a 17 | real, intent(in out), dimension(m, l) :: b 18 | real, intent(in out), dimension(n, l) :: c 19 | integer :: i, j, k 20 | real :: sum 21 | ! You should know how to multiply two matrix 22 | do i = 1, n 23 | do j = 1, l 24 | sum = 0.0 25 | do k = 1, m 26 | sum = sum + a(i, k) * b(k, j) 27 | end do 28 | c(i, j) = sum 29 | end do 30 | end do 31 | end subroutine MatrixAB 32 | 33 | ! This subroutine reads a matrix of 34 | ! dimension nXm 35 | subroutine ReadMatrix(a, n, m) 36 | implicit none 37 | integer :: n, m 38 | real, intent(in out), dimension(n, m) :: a 39 | real :: buffer 40 | integer :: i, j 41 | write(*, '(Ai1A1i1)') "Enter a matrix of ", n, "x", m 42 | do i = 1, n 43 | do j = 1, m 44 | read *, buffer 45 | a(i, j) = real(buffer) 46 | end do 47 | end do 48 | end subroutine ReadMatrix 49 | 50 | ! This subroutine prints a matrix of 51 | ! dimension nXm 52 | subroutine PrintMatrix(a, n, m) 53 | implicit none 54 | integer :: n, m 55 | real, intent(in out), dimension(n, m) :: a 56 | integer :: i, j 57 | write(*, '(Ai1A1i1)') "Printing a matrix of ", n, "x", m 58 | do i = 1, n 59 | do j = 1, m 60 | write (*, '(f16.2)', advance = 'no') a(i, j) 61 | end do 62 | print *, '' 63 | end do 64 | end subroutine PrintMatrix 65 | 66 | ! This main program container 67 | program MatrixMultiplication 68 | implicit none 69 | integer :: n = 3, m = 3, l = 3 70 | real, dimension(3, 3) :: a, b, c 71 | print *, "This program multiplies 2 matrix and displays result" 72 | call ReadMatrix(a, n, m) 73 | call ReadMatrix(b, m, l) 74 | call MatrixAB(a, b, c, n, m, l) 75 | call PrintMatrix(c, n, l) 76 | end program MatrixMultiplication -------------------------------------------------------------------------------- /16. Newton General Difference Formula.f08: -------------------------------------------------------------------------------- 1 | ! File: Newton General Difference Formula.f08 2 | ! Author: Aakash Gajjar 3 | ! Created on August 27, 2016, 1:32 PM 4 | ! 5 | ! Subject: Implementation of Newton's General 6 | ! Difference formula 7 | 8 | ! The function that calculates factors in 9 | ! Newton's polynomial 10 | function factor(size, point, diff, x) 11 | implicit none 12 | real :: factor, point 13 | integer :: diff, size 14 | real, dimension(size) :: x 15 | integer :: i 16 | 17 | factor = 1.0 18 | if (diff > 1) then 19 | do i = 1, diff - 1 20 | factor = factor * (point - x(i)) 21 | end do 22 | end if 23 | end function factor 24 | 25 | ! The function that calculates Nth Difference required 26 | ! in Newton's Polynomial 27 | recursive function nDifference(size, diff, index, x, f) result(answer) 28 | implicit none 29 | real :: factor 30 | real :: answer 31 | integer :: size, diff, index 32 | real, dimension(size) :: x, f 33 | integer :: i 34 | 35 | answer = 0.0 36 | if (diff > 2) then 37 | answer = (nDifference(size, diff - 1, index, x, f) - & 38 | nDifference(size, diff - 1, index - 1, x, f))/& 39 | (x(index) - x(index - diff + 1)) 40 | else 41 | answer = (f(index) - f(index - 1))/(x(index) - x(index - 1)) 42 | end if 43 | end function nDifference 44 | 45 | ! The Function for Interpolation 46 | ! @args: x : array of x values 47 | ! f : array of f values 48 | ! size: length of array 49 | ! point: interpolation point 50 | function NGD(size, x, f, point) 51 | implicit none 52 | real :: NGD 53 | real :: factor, nDifference 54 | integer :: size 55 | real, dimension(size) :: x, f 56 | real :: point 57 | integer :: diff 58 | 59 | NGD = f(1) 60 | 61 | ! Again difference should start from 0 62 | do diff = 2, size 63 | NGD = NGD + factor(size, point, diff, x) * & 64 | nDifference(size, diff, diff, x, f) 65 | end do 66 | end function NGD 67 | 68 | ! The main program 69 | program NewtonInterpolation 70 | implicit none 71 | integer :: size = 5 72 | real, dimension(5) :: x, f 73 | real :: NGD 74 | real :: point = 1.86 75 | f = (/0.0, 1.0986, 1.6094, 1.9459, 2.1972/) 76 | x = (/1.0, 3.0, 5.0, 7.0, 9.0/) 77 | 78 | print *, NGD(size, x, f, point) 79 | end program NewtonInterpolation 80 | 81 | ! OUTPUT 82 | ! Function data 83 | ! f = 0.0, 1.0986, 1.6094, 1.9459, 2.1972 84 | ! Variable X data 85 | ! x = 1.0, 3.0, 5.0, 7.0, 9.0 86 | ! x = 1.83 87 | ! f = 0.584319830 -------------------------------------------------------------------------------- /33. Matrix Eigen Value.f08: -------------------------------------------------------------------------------- 1 | ! File: Matrix Eigen Value.f08 2 | ! Author: Aakash Gajjar 3 | ! Created on August 21, 2016, 2:53 PM 4 | ! 5 | ! Subject: This program implements a 6 | ! Power method that is used to find 7 | ! Eigen values of the system of equation 8 | ! 9 | 10 | program PowerMethod 11 | implicit none 12 | 13 | integer, parameter :: Row = 3, Col = 3 14 | real, dimension(Row, Col) :: matrixA, matrixB, matrixC 15 | real :: eigenValue, oldEigenValue 16 | integer :: i, j, k, m 17 | 18 | print *, "Enter Matrix Row-Wise" 19 | 20 | ! Read matrix matrixA and initialize 21 | ! matrixB 22 | do i = 1, Row 23 | print *, "Enter row no", i 24 | do j = 1, Col 25 | read *, matrixA(i, j) 26 | matrixB(i, j) = 0.0 27 | end do 28 | end do 29 | 30 | ! Start Process 31 | matrixB(1, 1) = 1.0 32 | oldEigenValue = 0.0 33 | 34 | do m = 0, 100 35 | 36 | !Multiply matrix 37 | do i = 1, Row 38 | do j = 1, Col 39 | matrixC(i, j) = 0.0 40 | do k = 1, Col 41 | matrixC(i, j) = & 42 | matrixC(i, j) + matrixA(i, k) * matrixB(k, j) 43 | end do 44 | end do 45 | end do 46 | 47 | !Initialize eigenValue with first element of matrixC 48 | eigenValue = matrixC(1, 1) 49 | do i = 1, Row 50 | do j = 1, Col 51 | if (matrixC(i, j) >= eigenValue) then 52 | eigenValue = matrixC(i, j) 53 | end if 54 | end do 55 | end do 56 | 57 | !Check if new value is equal to old value 58 | ! if it is we terminate process here 59 | if (eigenValue == oldEigenValue) then 60 | exit 61 | end if 62 | 63 | !Assign new to old 64 | oldEigenValue = eigenValue 65 | 66 | !Normalize matrixC 67 | !Assign matrixC TO matrixB 68 | do i = 1, Row 69 | do j = 1, Col 70 | matrixC(i, j) = matrixC(i, j)/eigenValue 71 | matrixB(i, j) = matrixC(i, j) 72 | end do 73 | end do 74 | 75 | end do 76 | 77 | print *, "Eigen Value = ", eigenValue 78 | 79 | !Print matrixC 80 | do i = 1, Row 81 | do j = 1, Col 82 | print *, matrixC(i, j) 83 | end do 84 | end do 85 | 86 | end program PowerMethod 87 | 88 | ! OUTPUT 89 | ! Enter Matrix Row-Wise 90 | ! Enter row no 1 91 | ! 2 92 | ! 4 93 | ! 3 94 | ! Enter row no 2 95 | ! 1 96 | ! 3 97 | ! 2 98 | ! Enter row no 3 99 | ! 3 100 | ! 6 101 | ! 1 102 | ! Eigen Value = 7.70009804 103 | ! 7.46673203 104 | ! 0.00000000 105 | ! 0.00000000 106 | ! 4.86520243 107 | ! 0.00000000 108 | ! 0.00000000 109 | ! 7.70009804 110 | ! 0.00000000 111 | ! 0.00000000 112 | -------------------------------------------------------------------------------- /15. Newton Forward Difference Interpolation.f08: -------------------------------------------------------------------------------- 1 | ! File: Newton Forward Difference Interpolation.f08 2 | ! Author: Aakash Gajjar 3 | ! Created on August 27, 2016, 12:06 PM 4 | ! 5 | ! Subject: Implementation of Newton's Forward 6 | ! Difference formula 7 | ! This program uses pascal triangle coefficients to 8 | ! calculate Nth difference 9 | 10 | ! The Function that calculates factorial 11 | function factorial(n) 12 | implicit none 13 | integer :: factorial, n 14 | integer :: i 15 | factorial = 1 16 | do i = 1, n 17 | factorial = i * factorial 18 | end do 19 | end function factorial 20 | 21 | ! The function that calculates factors in 22 | ! Newton's polynomial 23 | function factor(diff, stepSize) 24 | implicit none 25 | real :: factor 26 | integer :: diff 27 | real :: stepSize 28 | integer :: i 29 | 30 | factor = 1.0 31 | do i = 0, diff - 1 32 | factor = factor * (stepSize - i)/(i + 1) 33 | end do 34 | 35 | end function factor 36 | 37 | ! The function that calculates Nth Difference required 38 | ! in Newton's Polynomial 39 | function nDifference(size, diff, f) 40 | implicit none 41 | real :: nDifference, factor 42 | integer :: factorial 43 | integer :: size, diff 44 | real, dimension(size) :: f 45 | integer :: i, sign 46 | 47 | nDifference = 0.0 48 | do i = 0, diff 49 | if (mod(i, 2) == 0) then 50 | sign = 1 51 | else 52 | sign = -1 53 | end if 54 | ! Since fortran arrays start from 1 55 | ! i have added 1 to function value 56 | nDifference = nDifference + sign * f(diff - i + 1)& 57 | *(factorial(diff))/(factorial(i) * factorial(diff - i)) 58 | end do 59 | end function nDifference 60 | 61 | ! The Function for Interpolation 62 | ! @args: x : array of x values 63 | ! f : array of f values 64 | ! size: length of array 65 | ! point: interpolation point 66 | function NFD(size, x, f, point) 67 | implicit none 68 | real :: NFD 69 | real :: factor, nDifference 70 | integer :: size, step 71 | real, dimension(size) :: x, f 72 | real :: point, stepSize 73 | integer :: diff 74 | 75 | step = x(2) - x(1) 76 | stepSize = (point - x(1))/step 77 | 78 | NFD = f(1) 79 | 80 | ! Again difference should start from 0 81 | do diff = 2, size 82 | NFD = NFD + factor(diff - 1, stepSize) * nDifference(size, diff - 1, f) 83 | end do 84 | end function NFD 85 | 86 | ! The main program 87 | program NewtonInterpolation 88 | implicit none 89 | integer :: size = 5 90 | real, dimension(5) :: x, f 91 | real :: NFD 92 | real :: point = 1.83 93 | 94 | f = (/0.0, 1.0986, 1.6094, 1.9459, 2.1972/) 95 | x = (/1.0, 3.0, 5.0, 7.0, 9.0/) 96 | 97 | print *, NFD(size, x, f, point) 98 | end program NewtonInterpolation 99 | 100 | ! OUTPUT 101 | ! Function data 102 | ! f = 0.0, 1.0986, 1.6094, 1.9459, 2.1972 103 | ! Variable X data 104 | ! x = 1.0, 3.0, 5.0, 7.0, 9.0 105 | ! x = 1.83 106 | ! f = 0.567234695 -------------------------------------------------------------------------------- /14. Newton Backward Difference Formula.f08: -------------------------------------------------------------------------------- 1 | ! File: Newton Backward Difference Formula.f08 2 | ! Author: Aakash Gajjar 3 | ! Created on August 27, 2016, 1:23 PM 4 | ! 5 | ! Subject: Implementation of Newton's Backward 6 | ! Difference formula 7 | ! This program uses a pascal triangle coefficients to 8 | ! find Nth difference 9 | 10 | ! The Function that calculates factorial 11 | function factorial(n) 12 | implicit none 13 | integer :: factorial, n 14 | integer :: i 15 | factorial = 1 16 | do i = 1, n 17 | factorial = i * factorial 18 | end do 19 | end function factorial 20 | 21 | ! The function that calculates factors in 22 | ! Newton's polynomial 23 | function factor(diff, stepSize) 24 | implicit none 25 | real :: factor 26 | integer :: diff 27 | real :: stepSize 28 | integer :: i 29 | 30 | factor = 1.0 31 | do i = 0, diff - 1 32 | factor = factor * (stepSize + i)/(i + 1) 33 | end do 34 | 35 | end function factor 36 | 37 | ! The function that calculates Nth Difference required 38 | ! in Newton's Polynomial 39 | function nDifference(size, diff, f) 40 | implicit none 41 | real :: nDifference, factor 42 | integer :: factorial 43 | integer :: size, diff 44 | real, dimension(size) :: f 45 | integer :: i, sign 46 | 47 | nDifference = 0.0 48 | do i = 0, diff 49 | if (mod(i, 2) == 0) then 50 | sign = 1 51 | else 52 | sign = -1 53 | end if 54 | ! Since fortran arrays start from 1 and we from 0 55 | ! we have added 1 to function value 56 | nDifference = nDifference + sign * f(size - i)& 57 | *(factorial(diff))/(factorial(i) * factorial(diff - i)) 58 | end do 59 | end function nDifference 60 | 61 | ! The Function for Interpolation 62 | ! @args: x : array of x values 63 | ! f : array of f values 64 | ! size: length of array 65 | ! point: interpolation point 66 | function NBD(size, x, f, point) 67 | implicit none 68 | real :: NBD 69 | real :: factor, nDifference 70 | integer :: size, step 71 | real, dimension(size) :: x, f 72 | real :: point, stepSize 73 | integer :: diff 74 | 75 | step = x(2) - x(1) 76 | stepSize = (point - x(size))/step 77 | 78 | ! Initialized with f(size) It's Backward Difference 79 | NBD = f(size) 80 | 81 | ! Again difference should start from 0 82 | do diff = 2, size 83 | NBD = NBD + & 84 | factor(diff - 1, stepSize) * nDifference(size, diff - 1, f) 85 | end do 86 | end function NBD 87 | 88 | ! The main program 89 | program NewtonInterpolation 90 | implicit none 91 | integer :: size = 5 92 | real, dimension(5) :: x, f 93 | real :: NBD 94 | real :: point = 1.83 95 | 96 | ! Function data 97 | f = (/0.0, 1.0986, 1.6094, 1.9459, 2.1972/) 98 | ! Variable X data 99 | x = (/1.0, 3.0, 5.0, 7.0, 9.0/) 100 | 101 | print *, NBD(size, x, f, point) 102 | end program NewtonInterpolation 103 | 104 | ! OUTPUT 105 | ! Function data 106 | ! f = 0.0, 1.0986, 1.6094, 1.9459, 2.1972 107 | ! Variable X data 108 | ! x = 1.0, 3.0, 5.0, 7.0, 9.0 109 | ! x = 1.83 110 | ! f = 0.567234159 -------------------------------------------------------------------------------- /13. Create Difference Table.f08: -------------------------------------------------------------------------------- 1 | ! File: Create Difference Table.f08 2 | ! Author: Aakash Gajjar 3 | ! Created on August 26, 2016, 9:23 PM 4 | ! 5 | ! Subject: This program calculates 6 | ! difference table and checks whether it has 7 | ! any error in observation sample 8 | ! 9 | 10 | ! This is just a utility function that 11 | ! initializes a matrix with supplied value 12 | function Init(N, x, val) 13 | implicit none 14 | integer :: Init, N 15 | real, dimension(N, N) :: x 16 | real :: val 17 | integer :: i, j 18 | do i = 1, N 19 | do j = 1, N 20 | x(i, j) = val 21 | end do 22 | end do 23 | Init = 1 24 | end function Init 25 | 26 | ! This function checks whether error exists 27 | ! in data 28 | function checkError(N, x) 29 | integer :: checkError, N 30 | real, dimension(N, N) :: x 31 | integer :: i 32 | 33 | checkError = 0 34 | do i = 1, N 35 | if (floor(x(i, N - 1)) /= 0) then 36 | checkError = 1 37 | return 38 | endif 39 | end do 40 | 41 | end function checkError 42 | 43 | ! The main function that calculates difference 44 | ! table 45 | ! The implementation is straight forward using 46 | ! matrix as data container 47 | function makeDiffTable(N, x) 48 | implicit none 49 | integer :: makeDiffTable, N, checkError 50 | real, dimension(N, N) :: x 51 | integer :: i, j 52 | 53 | do j = 2, N 54 | do i = 1, N - j + 1 55 | x(i, j) = x(i + 1, j - 1) - x(i, j - 1) 56 | end do 57 | end do 58 | 59 | makeDiffTable = 0 60 | if (checkError(N, x) == 1) then 61 | makeDiffTable = 1 62 | return 63 | endif 64 | 65 | end function makeDiffTable 66 | 67 | ! Main program data container 68 | program DifferenceTable 69 | implicit none 70 | integer :: makeDiffTable, N = 6, Init 71 | real, dimension(6, 6) :: x 72 | integer :: i, j 73 | 74 | i = Init(N, x, 0.0) 75 | 76 | ! Set the X values 77 | x(1, 1) = 0 78 | x(2, 1) = 4 79 | x(3, 1) = 9 80 | x(4, 1) = 12 81 | x(5, 1) = 16 82 | x(6, 1) = 20 83 | 84 | if (makeDiffTable(N, x) == 1) then 85 | print *, "Error Exist" 86 | else 87 | print *, "Wow No Error!" 88 | endif 89 | 90 | do i = 1, N 91 | do j = 1, N 92 | write (*, '(f8.2) ', advance = 'no') x(i, j) 93 | end do 94 | print *, '' 95 | end do 96 | 97 | end program DifferenceTable 98 | 99 | ! OUTPUT 100 | ! 1. 101 | ! Wow No Error! 102 | ! 0.00 4.00 0.00 0.00 0.00 0.00 103 | ! 4.00 4.00 0.00 0.00 0.00 0.00 104 | ! 8.00 4.00 0.00 0.00 0.00 0.00 105 | ! 12.00 4.00 0.00 0.00 0.00 0.00 106 | ! 16.00 4.00 0.00 0.00 0.00 0.00 107 | ! 20.00 0.00 0.00 0.00 0.00 0.00 108 | ! 2. 109 | ! Error Exist 110 | ! 0.00 4.00 1.00 -3.00 6.00 -10.00 111 | ! 4.00 5.00 -2.00 3.00 -4.00 0.00 112 | ! 9.00 3.00 1.00 -1.00 0.00 0.00 113 | ! 12.00 4.00 0.00 0.00 0.00 0.00 114 | ! 16.00 4.00 0.00 0.00 0.00 0.00 115 | ! 20.00 0.00 0.00 0.00 0.00 0.00 -------------------------------------------------------------------------------- /31. Gauss Elimination.f08: -------------------------------------------------------------------------------- 1 | ! File: Gauss Elimination.f08 2 | ! Author: Aakash Gajjar 3 | ! Created on August 29, 2016, 10:22 PM 4 | ! 5 | ! Subject: Implementation of Naive Gauss Elimination 6 | ! Method 7 | ! 8 | 9 | ! The main subroutine that does the 10 | ! Gauss Elimination 11 | subroutine GaussElimination(a, n, m) 12 | implicit none 13 | integer, intent(in) :: n, m 14 | real, intent(in out) :: a(n, m) 15 | real :: first, second 16 | integer :: row, col 17 | integer :: i, j 18 | do i = 2, n 19 | ! The first column element of Selected row 20 | ! which we want to eliminate from all other 21 | ! rows 22 | first = a(i - 1, i - 1) 23 | do row = i, n 24 | ! This is the element which we will multiply 25 | ! to make that [row,row] element zero 26 | second = a(row, i - 1) 27 | ! Main loop that does the elimination work 28 | do col = i - 1, m 29 | ! Check the Gauss Elimination Method 30 | a(row, col) = a(row, col) - & 31 | second * a(i - 1, col)/first 32 | end do 33 | end do 34 | end do 35 | return 36 | end subroutine GaussElimination 37 | 38 | ! This subroutine solves the equations 39 | ! using back substitution 40 | ! It starts from the last row and goes to first 41 | subroutine SolveX(a, n, m, x) 42 | implicit none 43 | integer :: n, m 44 | real :: a(n, m) 45 | real :: x(n) 46 | integer :: row, col 47 | real :: sum 48 | 49 | ! We want to sum the multiplication of x value and it's 50 | ! coefficient and then subtract it from the coefficient C 51 | ! and divide that with the coefficient of x for which we 52 | ! want to solve 53 | do row = n, 0, -1 54 | sum = 0 55 | ! Multiply x and coefficient and compute it's sum 56 | do col = row + 1, m - 1 57 | sum = sum + a(row, col) * x(col) 58 | end do 59 | ! Subtract sum from coefficient C and divide with 60 | ! the coefficient of X 61 | x(row) = (a(row, m) - sum)/a(row, row) 62 | end do 63 | end subroutine SolveX 64 | 65 | ! This is just a utility subroutine that prints 66 | ! a matrix supplied with appropriate dimensions 67 | subroutine PrintMatrix(a, m, n) 68 | implicit none 69 | integer :: m, n 70 | real, intent(in out) :: a(m, n) 71 | integer :: i, j 72 | do i = 1, m 73 | do j = 1, n 74 | write(*, '(f18.2)', advance = "no") a(i, j) 75 | end do 76 | print *, '' 77 | end do 78 | end subroutine PrintMatrix 79 | 80 | ! This is another utility function that prints 81 | ! Array of supplied length 82 | subroutine PrintArray(a, m) 83 | implicit none 84 | integer :: m 85 | real, intent(in out) :: a(m) 86 | integer :: i 87 | print *, '' 88 | do i = 1, m 89 | write(*, '(f18.2) ', advance = "no") a(i) 90 | end do 91 | print *, '' 92 | end subroutine PrintArray 93 | 94 | ! The main program container 95 | program SolveEquations 96 | implicit none 97 | real, dimension(3, 4) :: a = & 98 | reshape((/2, 1, 3, 4, 3, 6, 3, 2, 1, 13, 9, 16/), (/3, 4/)) 99 | real, dimension(3) :: x 100 | integer :: rows = 3, cols = 4 101 | print *, "Input System of equations:" 102 | call PrintMatrix(a, rows, cols) 103 | call GaussElimination(a, rows, cols) 104 | print *, "Output:" 105 | call PrintMatrix(a, rows, cols) 106 | call SolveX(a, rows, cols, x) 107 | print *, "Solution:" 108 | call PrintArray(x, rows) 109 | end program SolveEquations 110 | 111 | ! OUTPUT 112 | ! Input System of equations: 113 | ! 2.00 4.00 3.00 13.00 114 | ! 1.00 3.00 2.00 9.00 115 | ! 3.00 6.00 1.00 16.00 116 | ! Output: 117 | ! 2.00 4.00 3.00 13.00 118 | ! 0.00 1.00 0.50 2.50 119 | ! 0.00 0.00 -3.50 -3.50 120 | ! Solution: 121 | ! 1.00 2.00 1.00 -------------------------------------------------------------------------------- /32. Gauss Jordan Elimination.f08: -------------------------------------------------------------------------------- 1 | ! File: Gauss Jordan Elimination.f08 2 | ! Author: Aakash Gajjar 3 | ! Created on August 31, 2016, 8:21 PM 4 | ! 5 | ! Subject: Implementation of Gauss Jordan 6 | ! Elimination Method for Solving 7 | ! Systems of Equation 8 | 9 | ! In this program a matrix stores value of 10 | ! RHS of equations in last column 11 | 12 | ! Main subroutine is GaussJordan which takes 13 | ! number of rows, => rows 14 | ! number of cols, => cols 15 | ! Matrix a containing x coefficients => a(rows,cols) 16 | ! as it's arguments 17 | 18 | ! This subroutine Normalizes a given row in matrix by 19 | ! it's first non-zero element 20 | subroutine Normalize(rows, cols, a, row) 21 | implicit none 22 | integer :: rows, cols 23 | real :: a(rows, cols) 24 | integer :: row 25 | integer :: i 26 | real :: pivot 27 | pivot = a(row, row) 28 | do i = 1, cols 29 | a(row, i) = a(row, i)/pivot 30 | end do 31 | end subroutine Normalize 32 | 33 | ! This subroutine does the elimination part of 34 | ! Gauss Jordan method 35 | subroutine Eliminate(rows, cols, a, row) 36 | implicit none 37 | integer :: rows, cols 38 | real :: a(rows, cols) 39 | integer :: row 40 | integer :: i, j 41 | integer :: times 42 | real :: pivot 43 | 44 | do i = 1, rows 45 | if (i /= row) then 46 | pivot = a(i, row) 47 | do j = 1, cols 48 | a(i, j) = a(i, j) - pivot * a(row, j) 49 | end do 50 | end if 51 | end do 52 | end subroutine Eliminate 53 | 54 | ! Main subroutine call for Gauss Jordan Method 55 | subroutine GaussJordan(rows, cols, a) 56 | implicit none 57 | integer :: rows, cols 58 | real :: a(rows, cols) 59 | integer :: row, col 60 | 61 | ! It starts from first row upto last 62 | ! and calls required subroutine to 63 | ! do work 64 | do row = 1, rows 65 | call normalize(rows, cols, a, row) 66 | call eliminate(rows, cols, a, row) 67 | end do 68 | end subroutine GaussJordan 69 | 70 | ! This is just a small utility subroutine 71 | ! for displaying line before and after a 72 | ! matrix is printed 73 | subroutine DrawLine(cols) 74 | implicit none 75 | integer :: cols, j 76 | print *, '' 77 | do j = 1, cols 78 | write(*, "(A)", advance = "no") "========" 79 | end do 80 | print *, '' 81 | end subroutine DrawLine 82 | 83 | ! This subroutine prints a matrix 84 | subroutine PrintA(rows, cols, a) 85 | implicit none 86 | integer :: rows, cols 87 | real :: a(rows, cols) 88 | integer :: i, j 89 | call DrawLine(cols) 90 | do i = 1, rows 91 | do j = 1, cols 92 | write(*, "(f8.3)", advance = "no") a(i, j) 93 | end do 94 | print *, '' 95 | end do 96 | call DrawLine(cols) 97 | end subroutine PrintA 98 | 99 | ! This subroutine prints a matrix 100 | subroutine ReadA(rows, cols, a) 101 | implicit none 102 | integer :: rows, cols 103 | real :: a(rows, cols) 104 | integer :: i, j 105 | write(*, '(Ai1A1i1)') "Enter a matrix of ", & 106 | rows, "x", cols 107 | do i = 1, rows 108 | do j = 1, cols 109 | read *, a(i, j) 110 | end do 111 | end do 112 | end subroutine ReadA 113 | 114 | ! This subroutine reads dimensions of matrix 115 | subroutine ReadDimension(rows, cols) 116 | implicit none 117 | integer :: rows, cols 118 | write(*, "(A)", advance = "no") "Enter number of rows: " 119 | read *, rows 120 | cols = rows + 1 121 | end subroutine ReadDimension 122 | 123 | ! This subroutine prints a Info 124 | subroutine PrintInfo 125 | implicit none 126 | print *, "Gauss Jordan Elimination - SkyME5" 127 | print *, "This program stores RHS of equations " 128 | print *, "in last column of matrix so enter " 129 | print *, "dimensions accordingly" 130 | end subroutine PrintInfo 131 | 132 | ! The main program which defines matrix and it's 133 | ! component and calls requires procedures 134 | program GaussJordanElimination 135 | implicit none 136 | integer :: rows = 3, cols = 4 137 | real, allocatable, dimension(:,:) :: a 138 | call PrintInfo 139 | call ReadDimension(rows, cols) 140 | allocate(a(rows, cols)) 141 | call ReadA(rows, cols, a) 142 | call PrintA(rows, cols, a) 143 | call GaussJordan(rows, cols, a) 144 | print *, "Answer: " 145 | call PrintA(rows, cols, a) 146 | call system("pause") 147 | end program GaussJordanElimination 148 | 149 | ! OUTPUT 150 | ! Gauss Jordan Elimination - SkyME5 151 | ! This program stores RHS of equations 152 | ! in last column of matrix so enter 153 | ! dimensions accordingly 154 | ! Enter number of rows: 3 155 | ! Enter a matrix of 3x4 156 | ! 2 4 3 13 1 3 2 9 3 6 1 16 157 | ! ================================ 158 | ! 2.000 4.000 3.000 13.000 159 | ! 1.000 3.000 2.000 9.000 160 | ! 3.000 6.000 1.000 16.000 161 | ! ================================ 162 | ! Answer: 163 | ! ================================ 164 | ! 1.000 0.000 0.000 1.000 165 | ! 0.000 1.000 0.000 2.000 166 | ! -0.000 -0.000 1.000 1.000 -------------------------------------------------------------------------------- /34. Schrodinger Equation.f08: -------------------------------------------------------------------------------- 1 | ! File: Schrodinger Equation.f08 2 | ! Author: Aakash Gajjar 3 | ! Created on September 30, 2016, 3:54 AM 4 | ! 5 | ! Subject: Numerical Solution of Harmonic Oscillator 6 | ! using shooting method 7 | ! 8 | 9 | ! IMPORTANT NOTE HERE 10 | ! YOU NEED TO SET VALUE OF OMEGA IN FUNCTION G BELOW 11 | function w() 12 | implicit none 13 | real(kind = 8) :: w 14 | w = 1.0 15 | end function w 16 | 17 | ! Function f for RKFour 18 | function f(x, y1, y2) 19 | implicit none 20 | real(kind = 8) :: f 21 | real(kind = 8) :: x, y1, y2 22 | f = y2 23 | end function f 24 | 25 | ! Function g for RKFour 26 | function g(x, y1, y2, E) 27 | implicit none 28 | real(kind = 8) :: g 29 | real(kind = 8) :: x, y1, y2, E, V, w 30 | real(kind = 8) :: m = 1.0, h = 1.0 31 | !real(kind=8) :: w = 1.4 32 | V = (m * w() * w() * x * x)/2.0 33 | g = y1 * (V - E)*(2.0 * m)/(h * h) 34 | end function g 35 | 36 | ! Utility subroutine foe printing values 37 | subroutine PrintVal(a, b) 38 | implicit none 39 | real(kind = 8) :: a, b 40 | print *, a, b 41 | end subroutine PrintVal 42 | 43 | ! RKFour function to approximate value of yn 44 | ! @args steps : Number of steps to take 45 | ! low : low bound to x value 46 | ! high : high bound to x value, this is the value 47 | ! where we want to find yn 48 | ! x0 : initial x value 49 | ! y1_o,y2_o : initial y1, y2 values 50 | ! E : Gauss value of Energy 51 | ! prnt : Do we want to print y1, y2 values 52 | function RKFour(steps, low, high, x0, y1_o, y2_o, E, prnt) 53 | implicit none 54 | real(kind = 8) :: RKFour, f, g 55 | integer, intent(in) :: steps 56 | real(kind = 8), intent(in) :: low, high 57 | real(kind = 8), intent(in) :: x0 58 | real(kind = 8), intent(in) :: y1_o, y2_o 59 | real(kind = 8), intent(in) :: E 60 | integer :: prnt 61 | real(kind = 8) :: lastX, y1, y2 62 | real(kind = 8) :: stepSize 63 | real(kind = 8) :: f1, f2, f3, f0 64 | real(kind = 8) :: g1, g2, g3, g0 65 | integer :: i 66 | 67 | ! Determine step size 68 | stepSize = (high - low)/steps 69 | ! Assign values to variable 70 | lastX = x0 71 | y1 = y1_o 72 | y2 = y2_o 73 | ! If we want to print values 74 | if (prnt == 1) then 75 | call PrintVal(lastX, y1) 76 | ! Uncomment following line to print Probability density 77 | !call PrintVal(lastX,y2*y2) !Probability density 78 | end if 79 | 80 | ! Loop that does the most of the work 81 | do i = 1, steps 82 | lastX = lastX + stepSize 83 | 84 | f0 = f(lastX, y1, y2) 85 | g0 = g(lastX, y1, y2, E) 86 | 87 | f1 = f(lastX + stepSize/2.0, y1 + f0 * stepSize/2.0, & 88 | y2 + g0 * stepSize/2.0) 89 | g1 = g(lastX + stepSize/2.0, y1 + f0 * stepSize/2.0, & 90 | y2 + g0 * stepSize/2.0, E) 91 | 92 | f2 = f(lastX + stepSize/2.0, y1 + f1 * stepSize/2.0, & 93 | y2 + g1 * stepSize/2.0) 94 | g2 = g(lastX + stepSize/2.0, y1 + f1 * stepSize/2.0, & 95 | y2 + g1 * stepSize/2.0, E) 96 | 97 | f3 = f(lastX + stepSize, y1 + f2 * stepSize, y2 + & 98 | g2 * stepSize) 99 | g3 = g(lastX + stepSize, y1 + f2 * stepSize, y2 + & 100 | g2 * stepSize, E) 101 | 102 | y1 = y1 + stepSize * (f0 + 2.0 * f1 + 2.0 * f2 + f3)/6.0 103 | y2 = y2 + stepSize * (g0 + 2.0 * g1 + 2.0 * g2 + g3)/6.0 104 | 105 | if (prnt == 1) then 106 | call PrintVal(lastX, y1) 107 | ! Uncomment following line to print Probability density 108 | !call PrintVal(lastX,y2*y2) !Probability density 109 | end if 110 | end do 111 | RKFour = y1 112 | end function RKFour 113 | 114 | ! This subroutine does the shooting work 115 | subroutine SolveSHO(steps, x0, y1, y2, energy_low, & 116 | energy_high, energy) 117 | real(kind = 8), intent(in) :: x0 118 | integer, intent(in) :: steps 119 | real(kind = 8), intent(in) :: y1, y2 120 | real(kind = 8), intent(inout) :: energy_low, energy_high 121 | real(kind = 8), intent(inout) :: energy 122 | real(kind = 8) :: RKFour, energy_mid 123 | real(kind = 8) :: low, high, middle 124 | real(kind = 8) :: tolerance = 1e-10 125 | integer :: printing = 0, i 126 | ! Find y_n at 3 values low,middle and high 127 | ! and determines in which interval energy falls 128 | do i = 0, 2000 129 | energy_mid = (energy_high + energy_low)/2.0 130 | low = RKFour(1000, -x0, x0, -x0, y1, y2, & 131 | energy_low, printing) 132 | high = RKFour(1000, -x0, x0, -x0, y1, y2, & 133 | energy_high, printing) 134 | middle = RKFour(1000, -x0, x0, -x0, y1, y2, & 135 | energy_mid, printing) 136 | ! Just for break 137 | if (abs(energy_high - energy_low) < tolerance) then 138 | goto 23 139 | endif 140 | if (middle * high > 0) then 141 | energy_high = (energy_low + energy_high)/2.0 142 | end if 143 | if (middle * low > 0) then 144 | energy_low = (energy_low + energy_high)/2.0 145 | end if 146 | end do 147 | 23 energy = (energy_low + energy_high)/2.0 148 | end subroutine SolveSHO 149 | 150 | program Schrodinger 151 | implicit none 152 | real(kind = 8) :: x0 = 3.0 153 | integer :: steps = 10000 154 | real(kind = 8) :: y1 = 0.0, y2 = -1.0 155 | real(kind = 8) :: energy_low, energy_high 156 | real(kind = 8) :: energy = 0 157 | real(kind = 8) :: RKFour, w 158 | real(kind = 8) :: temporary 159 | integer :: printing, i 160 | do i = 0, 20 161 | energy_low = i + 0.15 162 | energy_high = i + 1.2 163 | !printing = 1 164 | call SolveSHO(steps, x0, y1, y2, energy_low, & 165 | energy_high, energy) 166 | !temporary = RKFour(steps*1000, -x0, x0, -x0, y1, y2, energy, printing) 167 | print "(a,i4,a,f8.4,a,f8.4,a,ES10.3)", "#State:",i," Energy:", energy, " Th: ", w()*(i + 0.5),& 168 | " %Error: ", 100 * (energy - w()*(i + 0.5))/energy 169 | end do 170 | end program Schrodinger 171 | 172 | ! OUTPUT 173 | ! #State: 0 Energy: 0.5004 Th: 0.5000 %Error: 7.820E-02 174 | ! #State: 1 Energy: 1.5061 Th: 1.5000 %Error: 4.039E-01 175 | ! #State: 2 Energy: 2.5411 Th: 2.5000 %Error: 1.619E+00 176 | ! #State: 3 Energy: 3.6642 Th: 3.5000 %Error: 4.482E+00 177 | ! #State: 4 Energy: 4.9542 Th: 4.5000 %Error: 9.168E+00 178 | ! #State: 5 Energy: 5.5000 Th: 5.5000 %Error: 1.852E-10 179 | ! #State: 6 Energy: 6.4734 Th: 6.5000 %Error: -4.115E-01 180 | ! #State: 7 Energy: 7.5000 Th: 7.5000 %Error: 1.358E-10 181 | ! #State: 8 Energy: 8.2529 Th: 8.5000 %Error: -2.994E+00 182 | ! #State: 9 Energy: 9.5000 Th: 9.5000 %Error: -3.346E-06 183 | ! #State: 10 Energy: 10.3038 Th: 10.5000 %Error: -1.904E+00 184 | ! #State: 11 Energy: 11.5000 Th: 11.5000 %Error: -2.764E-06 185 | ! #State: 12 Energy: 12.6291 Th: 12.5000 %Error: 1.022E+00 186 | ! #State: 13 Energy: 13.5000 Th: 13.5000 %Error: -2.355E-06 187 | ! #State: 14 Energy: 14.5000 Th: 14.5000 %Error: -2.192E-06 188 | ! #State: 15 Energy: 15.2294 Th: 15.5000 %Error: -1.777E+00 189 | ! #State: 16 Energy: 16.5000 Th: 16.5000 %Error: 6.175E-11 190 | ! #State: 17 Energy: 18.1047 Th: 17.5000 %Error: 3.340E+00 191 | ! #State: 18 Energy: 18.5000 Th: 18.5000 %Error: 5.508E-11 192 | ! #State: 19 Energy: 19.5000 Th: 19.5000 %Error: 5.225E-11 193 | ! #State: 20 Energy: 20.5000 Th: 20.5000 %Error: 4.970E-11 --------------------------------------------------------------------------------