Fortran Interview Questions with Answers

! Hello World in Fortran
program hello
    implicit none
    print *, "Hello, World!"
end program hello

! Data Types in Fortran
program datatypes
    implicit none
    integer :: age = 25
    real :: salary = 50000.50
    real :: pi = 3.14159265358979
    character :: grade = 'A'
    logical :: isActive = .true.
    character(len=10) :: name = "Alice"
    real :: price = 99.99
    
    print *, "Age: ", age
    print *, "Salary: ", salary
    print *, "Pi: ", pi
    print *, "Grade: ", grade
    print *, "Active: ", isActive
    print *, "Name: ", name
    print *, "Price: ", price
end program datatypes

! Variables and Constants in Fortran
program variables
    implicit none
    integer :: x = 10
    real, parameter :: pi = 3.14159
    real :: val = 3.14
    character(len=10) :: str = "Hello"
    integer :: counter = 0
    
    print *, "x = ", x
    print *, "pi = ", pi
    print *, "val = ", val
    print *, "str = ", str
    print *, "counter = ", counter
end program variables

! Arrays in Fortran
program arrays
    implicit none
    integer, dimension(5) :: arr = [1, 2, 3, 4, 5]
    integer, dimension(3, 3) :: matrix
    integer :: i, j
    
    ! Access elements
    print *, "arr(1) = ", arr(1)
    print *, "arr(3) = ", arr(3)
    
    ! 2D array
    matrix = reshape([1, 2, 3, 4, 5, 6, 7, 8, 9], [3, 3])
    print *, "matrix(2,2) = ", matrix(2,2)
    
    ! Array operations
    arr = arr * 2
    print *, "Doubled: ", arr
    
    ! Array slicing
    print *, "First three: ", arr(1:3)
end program arrays

! Functions and Subroutines in Fortran
module math_operations
contains
    ! Function
    function add(a, b) result(sum)
        integer, intent(in) :: a, b
        integer :: sum
        sum = a + b
    end function add
    
    ! Subroutine
    subroutine subtract(a, b, result)
        integer, intent(in) :: a, b
        integer, intent(out) :: result
        result = a - b
    end subroutine subtract
    
    ! Recursive function
    recursive function factorial(n) result(fact)
        integer, intent(in) :: n
        integer :: fact
        if (n <= 1) then
            fact = 1
        else
            fact = n * factorial(n - 1)
        end if
    end function factorial
end module math_operations

program test_math
    use math_operations
    implicit none
    integer :: result, sub_result
    
    result = add(10, 20)
    print *, "Add: ", result
    
    call subtract(20, 10, sub_result)
    print *, "Subtract: ", sub_result
    
    print *, "Factorial 5: ", factorial(5)
end program test_math

! Recursion in Fortran
module recursive_examples
contains
    ! Fibonacci
    recursive function fibonacci(n) result(fib)
        integer, intent(in) :: n
        integer :: fib
        if (n <= 1) then
            fib = n
        else
            fib = fibonacci(n - 1) + fibonacci(n - 2)
        end if
    end function fibonacci
    
    ! Sum of array using recursion
    recursive function sum_array(arr, n) result(sum)
        integer, dimension(:), intent(in) :: arr
        integer, intent(in) :: n
        integer :: sum
        if (n <= 0) then
            sum = 0
        else
            sum = arr(n) + sum_array(arr, n - 1)
        end if
    end function sum_array
end module recursive_examples

program test_recursion
    use recursive_examples
    implicit none
    integer :: fib_result
    integer, dimension(5) :: arr = [1, 2, 3, 4, 5]
    
    fib_result = fibonacci(8)
    print *, "Fibonacci 8: ", fib_result
    
    print *, "Sum array: ", sum_array(arr, 5)
end program test_recursion

! Derived Types in Fortran
module types
    implicit none
    
    ! Derived type (struct)
    type :: Person
        character(len=20) :: name
        integer :: age
        character(len=30) :: email
    end type Person
    
    ! Derived type with allocatable components
    type :: Student
        type(Person) :: person
        character(len=20) :: major
        real :: gpa
    end type Student
end module types

program test_types
    use types
    implicit none
    type(Person) :: alice
    type(Student) :: bob
    
    ! Initialize
    alice = Person("Alice", 25, "alice@email.com")
    bob%person = Person("Bob", 22, "bob@email.com")
    bob%major = "Computer Science"
    bob%gpa = 3.85
    
    print *, "Name: ", alice%name
    print *, "Age: ", alice%age
    print *, "Student: ", bob%person%name, ", GPA: ", bob%gpa
end program test_types

! Modules in Fortran
module math_constants
    implicit none
    real, parameter :: PI = 3.14159265358979
    real, parameter :: E = 2.71828182845905
end module math_constants

module geometry
    use math_constants
    implicit none
contains
    function circle_area(radius) result(area)
        real, intent(in) :: radius
        real :: area
        area = PI * radius * radius
    end function circle_area
    
    function circle_circumference(radius) result(circ)
        real, intent(in) :: radius
        real :: circ
        circ = 2.0 * PI * radius
    end function circle_circumference
end module geometry

program test_geometry
    use geometry
    implicit none
    real :: r = 5.0
    
    print *, "Circle area: ", circle_area(r)
    print *, "Circle circumference: ", circle_circumference(r)
end program test_geometry

! File I/O in Fortran
program file_io
    implicit none
    integer :: i, ios
    character(len=20) :: name
    integer :: age
    real :: gpa
    
    ! Write to file
    open(unit=10, file="students.txt", status="replace", action="write")
    write(10, *) "Alice", 20, 3.85
    write(10, *) "Bob", 22, 3.62
    write(10, *) "Carol", 21, 3.91
    close(10)
    
    ! Read from file
    open(unit=10, file="students.txt", status="old", action="read")
    print *, "Students:"
    do i = 1, 3
        read(10, *, iostat=ios) name, age, gpa
        if (ios /= 0) exit
        print *, name, age, gpa
    end do
    close(10)
    
    ! Append to file
    open(unit=10, file="students.txt", status="old", action="write", position="append")
    write(10, *) "Dave", 23, 3.75
    close(10)
end program file_io

! Pointers in Fortran
program pointers
    implicit none
    integer, pointer :: p1, p2
    integer, target :: x = 10
    integer, target :: y = 20
    
    ! Associate pointer with target
    p1 => x
    p2 => y
    
    print *, "p1 points to: ", p1
    print *, "p2 points to: ", p2
    
    ! Change through pointer
    p1 = 30
    print *, "x after p1 = 30: ", x
    
    ! Nullify pointer
    nullify(p1)
    
    ! Allocatable pointers
    integer, dimension(:), allocatable :: arr
    allocate(arr(5))
    arr = [1, 2, 3, 4, 5]
    print *, "arr: ", arr
    deallocate(arr)
end program pointers

! Control Structures in Fortran
program control_structures
    implicit none
    integer :: i, num
    logical :: found
    
    ! IF statement
    num = 10
    if (num > 0) then
        print *, "num is positive"
    else if (num < 0) then
        print *, "num is negative"
    else
        print *, "num is zero"
    end if
    
    ! DO loop
    do i = 1, 10
        print *, "i = ", i
    end do
    
    ! DO WHILE loop
    i = 1
    do while (i <= 5)
        print *, "while i = ", i
        i = i + 1
    end do
    
    ! SELECT CASE
    select case(num)
    case(0)
        print *, "num is zero"
    case(1:5)
        print *, "num between 1 and 5"
    case default
        print *, "num is greater than 5"
    end select
end program control_structures

! String Operations in Fortran
program strings
    implicit none
    character(len=20) :: str1 = "Hello"
    character(len=20) :: str2 = "World"
    character(len=40) :: result
    integer :: pos
    
    ! Concatenation
    result = trim(str1) // " " // trim(str2)
    print *, "Concatenated: ", result
    
    ! Length
    print *, "Length of str1: ", len_trim(str1)
    
    ! Substring
    print *, "Substring: ", str1(1:3)
    
    ! Index
    pos = index(str1, "ell")
    print *, "Position of 'ell': ", pos
    
    ! Convert to upper/lower
    print *, "Upper: ", str1
    print *, "Lower: ", str1
    
    ! Trim
    print *, "Trimmed: ", trim(str1)
end program strings

! Array Operations in Fortran
program array_ops
    implicit none
    integer, dimension(5) :: arr1 = [1, 2, 3, 4, 5]
    integer, dimension(5) :: arr2 = [5, 4, 3, 2, 1]
    integer, dimension(5) :: arr3
    integer :: i
    
    ! Element-wise operations
    arr3 = arr1 + arr2
    print *, "Sum: ", arr3
    
    arr3 = arr1 * arr2
    print *, "Product: ", arr3
    
    ! Array functions
    print *, "Sum of arr1: ", sum(arr1)
    print *, "Max of arr1: ", maxval(arr1)
    print *, "Min of arr1: ", minval(arr1)
    print *, "Average: ", sum(arr1) / size(arr1)
    
    ! Where statement
    where (arr1 > 3)
        arr3 = 99
    elsewhere
        arr3 = 0
    end where
    print *, "Where condition: ", arr3
    
    ! Array reshape
    integer, dimension(3, 3) :: matrix
    matrix = reshape([1, 2, 3, 4, 5, 6, 7, 8, 9], [3, 3])
    print *, "Matrix: "
    do i = 1, 3
        print *, matrix(i, :)
    end do
end program array_ops

! Subroutines and Functions
module math_ops
contains
    ! Function returning a value
    function multiply(a, b) result(product)
        integer, intent(in) :: a, b
        integer :: product
        product = a * b
    end function multiply
    
    ! Subroutine with intent
    subroutine divide(a, b, quotient, remainder)
        integer, intent(in) :: a, b
        integer, intent(out) :: quotient, remainder
        quotient = a / b
        remainder = mod(a, b)
    end subroutine divide
    
    ! Function with optional arguments
    function power(base, exponent) result(result)
        real, intent(in) :: base
        integer, optional, intent(in) :: exponent
        real :: result
        integer :: exp
        
        if (present(exponent)) then
            exp = exponent
        else
            exp = 2
        end if
        
        result = base ** exp
    end function power
end module math_ops

program test_ops
    use math_ops
    implicit none
    integer :: q, r
    
    print *, "Multiply: ", multiply(5, 4)
    call divide(10, 3, q, r)
    print *, "Quotient: ", q, " Remainder: ", r
    print *, "Power: ", power(2.0, 3)
    print *, "Power default: ", power(2.0)
end program test_ops

! Error Handling in Fortran
program error_handling
    implicit none
    integer :: ios, unit, i
    real :: x
    
    ! File error handling
    open(unit=10, file="nonexistent.txt", status="old", iostat=ios)
    if (ios /= 0) then
        print *, "Error opening file: ", ios
    else
        close(10)
    end if
    
    ! Read error handling
    open(unit=10, file="numbers.txt", status="old", action="read", iostat=ios)
    if (ios == 0) then
        do i = 1, 5
            read(10, *, iostat=ios) x
            if (ios /= 0) then
                print *, "Error reading at line: ", i
                exit
            end if
            print *, x
        end do
        close(10)
    end if
    
    ! Division by zero
    integer :: a = 10, b = 0
    if (b /= 0) then
        print *, a / b
    else
        print *, "Division by zero prevented"
    end if
end program error_handling

! Command Line Arguments
program command_line
    implicit none
    integer :: num_args, i
    character(len=100) :: arg
    
    ! Get number of arguments
    num_args = command_argument_count()
    print *, "Number of arguments: ", num_args
    
    ! Print all arguments
    do i = 1, num_args
        call get_command_argument(i, arg)
        print *, "Argument ", i, ": ", trim(arg)
    end do
    
    ! Get program name
    call get_command_argument(0, arg)
    print *, "Program name: ", trim(arg)
end program command_line

! System Calls in Fortran
program system_calls
    implicit none
    integer :: status
    
    ! Execute system command
    call execute_command_line("ls -la", exitstat=status)
    if (status == 0) then
        print *, "Command executed successfully"
    else
        print *, "Command failed with status: ", status
    end if
    
    ! Get environment variable
    character(len=100) :: home
    call get_environment_variable("HOME", home)
    print *, "HOME directory: ", trim(home)
end program system_calls

! Random Numbers in Fortran
program random_numbers
    implicit none
    real :: x
    integer :: seed_size, i
    integer, dimension(:), allocatable :: seed
    
    ! Initialize random seed
    call random_seed(size=seed_size)
    allocate(seed(seed_size))
    seed = 12345
    call random_seed(put=seed)
    
    ! Generate random numbers
    do i = 1, 10
        call random_number(x)
        print *, "Random number: ", x
    end do
    
    ! Generate random integer
    integer :: n
    call random_number(x)
    n = int(x * 100) + 1
    print *, "Random integer 1-100: ", n
end program random_numbers

! Date and Time in Fortran
program date_time
    implicit none
    integer :: values(8)
    character(len=20) :: date_str, time_str
    
    ! Get date and time
    call date_and_time(date_str, time_str, values=values)
    
    print *, "Date: ", date_str
    print *, "Time: ", time_str
    print *, "Year: ", values(1)
    print *, "Month: ", values(2)
    print *, "Day: ", values(3)
    print *, "Hour: ", values(5)
    print *, "Minute: ", values(6)
    print *, "Second: ", values(7)
    
    ! Calculate elapsed time
    real :: start_time, end_time
    call cpu_time(start_time)
    ! Do some work
    call cpu_time(end_time)
    print *, "CPU time: ", end_time - start_time, " seconds"
end program date_time

! Allocatable Arrays in Fortran
program allocatable_arrays
    implicit none
    integer, dimension(:), allocatable :: arr1, arr2
    integer :: n, i
    
    ! Allocate array
    n = 10
    allocate(arr1(n))
    arr1 = [(i, i = 1, n)]
    
    ! Reallocate array
    allocate(arr2(n))
    arr2 = arr1 * 2
    
    print *, "arr1: ", arr1
    print *, "arr2: ", arr2
    
    ! Deallocate array
    deallocate(arr1, arr2)
    
    ! Allocatable array in derived type
    type :: Matrix
        real, dimension(:,:), allocatable :: data
        integer :: rows, cols
    end type Matrix
    
    type(Matrix) :: m
    allocate(m%data(3, 3))
    m%rows = 3
    m%cols = 3
    m%data = reshape([1.0, 2.0, 3.0, 4.0, 5.0, 6.0, 7.0, 8.0, 9.0], [3, 3])
    print *, "Matrix data: ", m%data
    deallocate(m%data)
end program allocatable_arrays

! Pure and Elemental Functions
module pure_functions
contains
    ! Pure function - no side effects
    pure function square(x) result(y)
        real, intent(in) :: x
        real :: y
        y = x * x
    end function square
    
    ! Elemental function - works on arrays element-wise
    elemental real function cube(x)
        real, intent(in) :: x
        cube = x * x * x
    end function cube
end module pure_functions

program test_pure
    use pure_functions
    implicit none
    real :: arr(5) = [1.0, 2.0, 3.0, 4.0, 5.0]
    real :: arr2(5)
    
    arr2 = square(arr)
    print *, "Squares: ", arr2
    
    arr2 = cube(arr)
    print *, "Cubes: ", arr2
end program test_pure

! Generic Interfaces in Fortran
module generic_math
    interface add
        module procedure add_int, add_real
    end interface add
    
contains
    function add_int(a, b) result(c)
        integer, intent(in) :: a, b
        integer :: c
        c = a + b
    end function add_int
    
    function add_real(a, b) result(c)
        real, intent(in) :: a, b
        real :: c
        c = a + b
    end function add_real
end module generic_math

program test_generic
    use generic_math
    implicit none
    
    print *, "Integer add: ", add(5, 3)
    print *, "Real add: ", add(5.5, 3.2)
end program test_generic

! Overloaded Operators in Fortran
module vector_ops
    type :: Vector
        real :: x, y, z
    end type Vector
    
    interface operator(+)
        module procedure vector_add
    end interface operator(+)
    
    interface operator(*)
        module procedure vector_scalar_multiply
    end interface operator(*)
    
contains
    function vector_add(v1, v2) result(v3)
        type(Vector), intent(in) :: v1, v2
        type(Vector) :: v3
        v3%x = v1%x + v2%x
        v3%y = v1%y + v2%y
        v3%z = v1%z + v2%z
    end function vector_add
    
    function vector_scalar_multiply(v, s) result(result)
        type(Vector), intent(in) :: v
        real, intent(in) :: s
        type(Vector) :: result
        result%x = v%x * s
        result%y = v%y * s
        result%z = v%z * s
    end function vector_scalar_multiply
end module vector_ops

program test_operators
    use vector_ops
    implicit none
    type(Vector) :: v1, v2, v3
    
    v1 = Vector(1.0, 2.0, 3.0)
    v2 = Vector(4.0, 5.0, 6.0)
    v3 = v1 + v2
    print *, "v1 + v2: ", v3%x, v3%y, v3%z
    
    v3 = v1 * 2.0
    print *, "v1 * 2: ", v3%x, v3%y, v3%z
end program test_operators

! Type Casting and Conversion
program type_conversion
    implicit none
    integer :: i = 42
    real :: r
    complex :: c
    
    ! Integer to real
    r = real(i)
    print *, "Integer to real: ", r
    
    ! Real to integer (truncates)
    r = 3.14159
    i = int(r)
    print *, "Real to integer: ", i
    
    ! Complex numbers
    c = cmplx(3.0, 4.0)
    print *, "Complex: ", c
    print *, "Real part: ", real(c)
    print *, "Imaginary part: ", aimag(c)
    
    ! Character to integer
    character(len=10) :: str = "42"
    read(str, *) i
    print *, "String to integer: ", i
    
    ! Integer to character
    i = 42
    write(str, *) i
    print *, "Integer to string: ", trim(str)
end program type_conversion

! Dynamic Memory Allocation
program dynamic_memory
    implicit none
    integer :: n, i
    real, dimension(:), allocatable :: data
    real, dimension(:,:), allocatable :: matrix
    
    ! Allocate 1D array
    n = 1000000
    allocate(data(n))
    data = 1.0
    
    print *, "Allocated 1D array of size: ", n
    
    ! Allocate 2D array
    allocate(matrix(100, 100))
    matrix = 0.0
    matrix(1, 1) = 1.0
    
    print *, "Allocated 2D array: 100x100"
    
    ! Reallocate array (Fortran 2003+)
    deallocate(data)
    allocate(data(n/2))
    data = 2.0
    print *, "Reallocated to size: ", size(data)
    
    ! Clean up
    deallocate(data, matrix)
end program dynamic_memory

! Advanced Array Features
program advanced_arrays
    implicit none
    integer, dimension(10) :: arr
    integer :: i
    
    arr = [(i, i = 1, 10)]
    
    ! Array sections
    print *, "Full array: ", arr
    print *, "First five: ", arr(1:5)
    print *, "Even indices: ", arr(2:10:2)
    print *, "Last three: ", arr(8:10)
    
    ! Masked assignment
    where (arr > 5)
        arr = 99
    elsewhere
        arr = 0
    end where
    print *, "Where condition: ", arr
    
    ! Array constructor with implied do loop
    integer, dimension(5) :: arr2
    arr2 = [(i*2, i = 1, 5)]
    print *, "Implied DO: ", arr2
    
    ! Allocatable array with reshape
    integer, dimension(:,:), allocatable :: matrix
    allocate(matrix(3, 3))
    matrix = reshape([1, 2, 3, 4, 5, 6, 7, 8, 9], [3, 3])
    print *, "Matrix: "
    do i = 1, 3
        print *, matrix(i, :)
    end do
    deallocate(matrix)
end program advanced_arrays

! Fortran 90/95 Features
program f90_features
    implicit none
    ! Array section operations
    integer, dimension(10) :: arr = [1, 2, 3, 4, 5, 6, 7, 8, 9, 10]
    
    print *, "arr(1:5) = ", arr(1:5)
    print *, "arr(1:10:2) = ", arr(1:10:2)
    
    ! Where statement
    where (arr > 5) arr = 0
    print *, "after where: ", arr
    
    ! Forall statement
    forall (i = 1:10) arr(i) = i * 2
    print *, "after forall: ", arr
    
    ! Pure function example
    contains
    pure function square(x) result(y)
        integer, intent(in) :: x
        integer :: y
        y = x * x
    end function square
end program f90_features

! Fortran 2003 Features
program f2003_features
    implicit none
    ! Allocatable derived types
    type :: Node
        integer :: value
        type(Node), pointer :: next
    end type Node
    
    ! Stream I/O
    integer :: unit = 10
    character(len=20) :: str
    
    ! New line escape
    print *, "Line 1"
    print *, "Line 2"
    
    ! Array constructor with type specification
    integer, dimension(5) :: arr = [integer :: 1, 2, 3, 4, 5]
    print *, "Type specified array: ", arr
    
    ! Flush statement
    print *, "Flushing output"
    flush(6)
    
    ! Iostat with messages
    integer :: ios
    open(unit=10, file="test.txt", status="old", iostat=ios)
    if (ios /= 0) then
        print *, "File not found"
    else
        close(10)
    end if
end program f2003_features

! Fortran 2008 Features
program f2008_features
    implicit none
    ! Coarrays (parallel programming)
    integer, dimension(10)[*] :: coarray
    
    ! Block construct
    block
        integer :: x
        x = 42
        print *, "x inside block: ", x
    end block
    
    ! Do concurrent
    integer, dimension(10) :: arr
    do concurrent (i = 1:10)
        arr(i) = i * 2
    end do
    print *, "Do concurrent result: ", arr
    
    ! Submodule
    ! Not shown in this simple example
    
    ! Intent with pointer
    interface
        subroutine proc(x)
            integer, pointer, intent(in) :: x
        end subroutine
    end interface
end program f2008_features

! Fortran 2018 Features
program f2018_features
    implicit none
    ! Better coarray support
    integer, dimension(10) :: coarray[*]
    
    ! Improved do concurrent
    integer :: i
    do concurrent (i = 1:10) shared(i)
        ! Do something
    end do
    
    ! Max and min with arrays
    integer, dimension(5) :: arr = [1, 2, 3, 4, 5]
    print *, "Max: ", maxval(arr)
    print *, "Min: ", minval(arr)
    
    ! Improved error handling
    integer :: ios
    character(len=100) :: msg
    
    open(unit=10, file="test.txt", status="old", iostat=ios, iomsg=msg)
    if (ios /= 0) then
        print *, "Error: ", trim(msg)
    else
        close(10)
    end if
end program f2018_features

! Binary Search in Fortran
module search
contains
    function binary_search(arr, target) result(index)
        integer, dimension(:), intent(in) :: arr
        integer, intent(in) :: target
        integer :: index
        integer :: left, right, mid
        
        left = 1
        right = size(arr)
        index = -1
        
        do while (left <= right)
            mid = (left + right) / 2
            if (arr(mid) == target) then
                index = mid
                return
            else if (arr(mid) < target) then
                left = mid + 1
            else
                right = mid - 1
            end if
        end do
    end function binary_search
end module search

program test_binary_search
    use search
    implicit none
    integer, dimension(10) :: arr = [2, 5, 8, 12, 16, 23, 38, 56, 72, 91]
    integer :: idx
    
    idx = binary_search(arr, 23)
    if (idx /= -1) then
        print *, "Found 23 at index: ", idx
    else
        print *, "Not found"
    end if
end program test_binary_search

! Quick Sort in Fortran
module sorting
contains
    recursive subroutine quick_sort(arr, first, last)
        integer, dimension(:), intent(inout) :: arr
        integer, intent(in) :: first, last
        integer :: pivot, i, j, temp
        
        if (first < last) then
            pivot = arr((first + last) / 2)
            i = first
            j = last
            
            do
                do while (arr(i) < pivot)
                    i = i + 1
                end do
                do while (arr(j) > pivot)
                    j = j - 1
                end do
                if (i >= j) exit
                
                temp = arr(i)
                arr(i) = arr(j)
                arr(j) = temp
                i = i + 1
                j = j - 1
            end do
            
            call quick_sort(arr, first, j)
            call quick_sort(arr, i, last)
        end if
    end subroutine quick_sort
end module sorting

program test_quick_sort
    use sorting
    implicit none
    integer, dimension(10) :: arr = [64, 34, 25, 12, 22, 11, 90, 1, 55, 47]
    
    print *, "Before sorting: ", arr
    call quick_sort(arr, 1, size(arr))
    print *, "After sorting: ", arr
end program test_quick_sort

! Merge Sort in Fortran
module merge_sort
contains
    recursive subroutine merge_sort(arr, temp, left, right)
        integer, dimension(:), intent(inout) :: arr, temp
        integer, intent(in) :: left, right
        integer :: mid
        
        if (left < right) then
            mid = (left + right) / 2
            call merge_sort(arr, temp, left, mid)
            call merge_sort(arr, temp, mid + 1, right)
            call merge(arr, temp, left, mid, right)
        end if
    end subroutine merge_sort
    
    subroutine merge(arr, temp, left, mid, right)
        integer, dimension(:), intent(inout) :: arr, temp
        integer, intent(in) :: left, mid, right
        integer :: i, j, k
        
        i = left
        j = mid + 1
        k = left
        
        do while (i <= mid .and. j <= right)
            if (arr(i) <= arr(j)) then
                temp(k) = arr(i)
                i = i + 1
            else
                temp(k) = arr(j)
                j = j + 1
            end if
            k = k + 1
        end do
        
        do while (i <= mid)
            temp(k) = arr(i)
            i = i + 1
            k = k + 1
        end do
        
        do while (j <= right)
            temp(k) = arr(j)
            j = j + 1
            k = k + 1
        end do
        
        arr(left:right) = temp(left:right)
    end subroutine merge
end module merge_sort

program test_merge_sort
    use merge_sort
    implicit none
    integer, dimension(8) :: arr = [38, 27, 43, 3, 9, 82, 10, 7]
    integer, dimension(8) :: temp
    
    print *, "Before sorting: ", arr
    call merge_sort(arr, temp, 1, size(arr))
    print *, "After sorting: ", arr
end program test_merge_sort

! Linked List Implementation
module linked_list
    implicit none
    type :: Node
        integer :: value
        type(Node), pointer :: next
    end type Node
    
    type :: LinkedList
        type(Node), pointer :: head => null()
    contains
        procedure :: push_front
        procedure :: push_back
        procedure :: display
        procedure :: destroy
    end type LinkedList
    
contains
    subroutine push_front(list, value)
        class(LinkedList), intent(inout) :: list
        integer, intent(in) :: value
        type(Node), pointer :: new_node
        
        allocate(new_node)
        new_node%value = value
        new_node%next => list%head
        list%head => new_node
    end subroutine push_front
    
    subroutine push_back(list, value)
        class(LinkedList), intent(inout) :: list
        integer, intent(in) :: value
        type(Node), pointer :: new_node, current
        
        allocate(new_node)
        new_node%value = value
        new_node%next => null()
        
        if (.not. associated(list%head)) then
            list%head => new_node
        else
            current => list%head
            do while (associated(current%next))
                current => current%next
            end do
            current%next => new_node
        end if
    end subroutine push_back
    
    subroutine display(list)
        class(LinkedList), intent(in) :: list
        type(Node), pointer :: current
        character(len=100) :: output
        
        current => list%head
        output = ""
        do while (associated(current))
            write(output, '(A,I0,A)') trim(output), current%value, " -> "
            current => current%next
        end do
        print *, trim(output), "null"
    end subroutine display
    
    subroutine destroy(list)
        class(LinkedList), intent(inout) :: list
        type(Node), pointer :: current, next_node
        
        current => list%head
        do while (associated(current))
            next_node => current%next
            deallocate(current)
            current => next_node
        end do
        list%head => null()
    end subroutine destroy
end module linked_list

program test_linked_list
    use linked_list
    implicit none
    type(LinkedList) :: list
    
    call list%push_back(10)
    call list%push_back(20)
    call list%push_back(30)
    call list%push_front(5)
    
    print *, "Linked List: "
    call list%display()
    
    call list%destroy()
end program test_linked_list

! Stack Implementation
module stack_mod
    implicit none
    type :: Stack
        integer, dimension(:), allocatable :: items
        integer :: top = 0
    contains
        procedure :: push
        procedure :: pop
        procedure :: peek
        procedure :: is_empty
        procedure :: size
    end type Stack
    
contains
    subroutine push(self, value)
        class(Stack), intent(inout) :: self
        integer, intent(in) :: value
        integer, dimension(:), allocatable :: temp
        
        if (.not. allocated(self%items)) then
            allocate(self%items(10))
            self%top = 0
        end if
        
        if (self%top >= size(self%items)) then
            ! Resize array
            allocate(temp(size(self%items) * 2))
            temp(1:size(self%items)) = self%items
            call move_alloc(temp, self%items)
        end if
        
        self%top = self%top + 1
        self%items(self%top) = value
    end subroutine push
    
    function pop(self) result(value)
        class(Stack), intent(inout) :: self
        integer :: value
        if (self%is_empty()) then
            value = -1
        else
            value = self%items(self%top)
            self%top = self%top - 1
        end if
    end function pop
    
    function peek(self) result(value)
        class(Stack), intent(in) :: self
        integer :: value
        if (self%is_empty()) then
            value = -1
        else
            value = self%items(self%top)
        end if
    end function peek
    
    function is_empty(self) result(empty)
        class(Stack), intent(in) :: self
        logical :: empty
        empty = self%top == 0 .or. .not. allocated(self%items)
    end function is_empty
    
    function size(self) result(s)
        class(Stack), intent(in) :: self
        integer :: s
        s = self%top
    end function size
end module stack_mod

program test_stack
    use stack_mod
    implicit none
    type(Stack) :: s
    
    call s%push(10)
    call s%push(20)
    call s%push(30)
    
    print *, "Stack size: ", s%size()
    print *, "Top element: ", s%peek()
    
    do while (.not. s%is_empty())
        print *, "Pop: ", s%pop()
    end do
end program test_stack

! Queue Implementation
module queue_mod
    implicit none
    type :: Queue
        integer, dimension(:), allocatable :: items
        integer :: front = 1
        integer :: rear = 0
    contains
        procedure :: enqueue
        procedure :: dequeue
        procedure :: peek
        procedure :: is_empty
        procedure :: size
    end type Queue
    
contains
    subroutine enqueue(self, value)
        class(Queue), intent(inout) :: self
        integer, intent(in) :: value
        integer, dimension(:), allocatable :: temp
        
        if (.not. allocated(self%items)) then
            allocate(self%items(10))
        end if
        
        if (self%rear >= size(self%items)) then
            allocate(temp(size(self%items) * 2))
            temp(1:self%rear - self%front + 1) = self%items(self%front:self%rear)
            call move_alloc(temp, self%items)
            self%front = 1
            self%rear = self%rear - self%front + 1
        end if
        
        self%rear = self%rear + 1
        self%items(self%rear) = value
    end subroutine enqueue
    
    function dequeue(self) result(value)
        class(Queue), intent(inout) :: self
        integer :: value
        if (self%is_empty()) then
            value = -1
        else
            value = self%items(self%front)
            self%front = self%front + 1
        end if
    end function dequeue
    
    function peek(self) result(value)
        class(Queue), intent(in) :: self
        integer :: value
        if (self%is_empty()) then
            value = -1
        else
            value = self%items(self%front)
        end if
    end function peek
    
    function is_empty(self) result(empty)
        class(Queue), intent(in) :: self
        logical :: empty
        empty = self%front > self%rear .or. .not. allocated(self%items)
    end function is_empty
    
    function size(self) result(s)
        class(Queue), intent(in) :: self
        integer :: s
        s = max(0, self%rear - self%front + 1)
    end function size
end module queue_mod

program test_queue
    use queue_mod
    implicit none
    type(Queue) :: q
    
    call q%enqueue(10)
    call q%enqueue(20)
    call q%enqueue(30)
    
    print *, "Queue size: ", q%size()
    print *, "Front element: ", q%peek()
    
    do while (.not. q%is_empty())
        print *, "Dequeue: ", q%dequeue()
    end do
end program test_queue

! Binary Tree Implementation
module binary_tree
    implicit none
    type :: TreeNode
        integer :: value
        type(TreeNode), pointer :: left => null()
        type(TreeNode), pointer :: right => null()
    end type TreeNode
    
    type :: BinaryTree
        type(TreeNode), pointer :: root => null()
    contains
        procedure :: insert
        procedure :: inorder
        procedure :: preorder
        procedure :: postorder
        procedure :: height
        procedure :: destroy
    end type BinaryTree
    
contains
    recursive subroutine insert(self, value)
        class(BinaryTree), intent(inout) :: self
        integer, intent(in) :: value
        if (.not. associated(self%root)) then
            allocate(self%root)
            self%root%value = value
        else
            call insert_node(self%root, value)
        end if
    end subroutine insert
    
    recursive subroutine insert_node(node, value)
        type(TreeNode), pointer, intent(inout) :: node
        integer, intent(in) :: value
        if (value < node%value) then
            if (.not. associated(node%left)) then
                allocate(node%left)
                node%left%value = value
            else
                call insert_node(node%left, value)
            end if
        else
            if (.not. associated(node%right)) then
                allocate(node%right)
                node%right%value = value
            else
                call insert_node(node%right, value)
            end if
        end if
    end subroutine insert_node
    
    recursive subroutine inorder(self, node)
        class(BinaryTree), intent(in) :: self
        type(TreeNode), pointer, intent(in) :: node
        if (associated(node)) then
            call self%inorder(node%left)
            print *, node%value
            call self%inorder(node%right)
        end if
    end subroutine inorder
    
    recursive subroutine destroy(self, node)
        class(BinaryTree), intent(inout) :: self
        type(TreeNode), pointer, intent(inout) :: node
        if (associated(node)) then
            call self%destroy(node%left)
            call self%destroy(node%right)
            deallocate(node)
        end if
    end subroutine destroy
    
    recursive function height(self, node) result(h)
        class(BinaryTree), intent(in) :: self
        type(TreeNode), pointer, intent(in) :: node
        integer :: h
        if (.not. associated(node)) then
            h = 0
        else
            h = 1 + max(self%height(node%left), self%height(node%right))
        end if
    end function height
end module binary_tree

program test_binary_tree
    use binary_tree
    implicit none
    type(BinaryTree) :: tree
    
    call tree%insert(50)
    call tree%insert(30)
    call tree%insert(70)
    call tree%insert(20)
    call tree%insert(40)
    call tree%insert(60)
    call tree%insert(80)
    
    print *, "Inorder traversal:"
    call tree%inorder(tree%root)
    
    print *, "Tree height: ", tree%height(tree%root)
    
    call tree%destroy(tree%root)
end program test_binary_tree

! Graph Adjacency Matrix
module graph
    implicit none
    type :: Graph
        integer :: vertices
        integer, dimension(:,:), allocatable :: adj_matrix
    contains
        procedure :: init
        procedure :: add_edge
        procedure :: dfs
        procedure :: bfs
        procedure :: print_graph
    end type Graph
    
contains
    subroutine init(self, v)
        class(Graph), intent(inout) :: self
        integer, intent(in) :: v
        self%vertices = v
        allocate(self%adj_matrix(v, v))
        self%adj_matrix = 0
    end subroutine init
    
    subroutine add_edge(self, u, v)
        class(Graph), intent(inout) :: self
        integer, intent(in) :: u, v
        if (u <= self%vertices .and. v <= self%vertices) then
            self%adj_matrix(u, v) = 1
            self%adj_matrix(v, u) = 1  ! For undirected graph
        end if
    end subroutine add_edge
    
    recursive subroutine dfs_recursive(self, v, visited)
        class(Graph), intent(in) :: self
        integer, intent(in) :: v
        logical, dimension(:), intent(inout) :: visited
        integer :: i
        
        visited(v) = .true.
        print *, "Visited: ", v
        
        do i = 1, self%vertices
            if (self%adj_matrix(v, i) == 1 .and. .not. visited(i)) then
                call self%dfs_recursive(i, visited)
            end if
        end do
    end subroutine dfs_recursive
    
    subroutine dfs(self, start)
        class(Graph), intent(in) :: self
        integer, intent(in) :: start
        logical, dimension(:), allocatable :: visited
        allocate(visited(self%vertices))
        visited = .false.
        call self%dfs_recursive(start, visited)
        deallocate(visited)
    end subroutine dfs
    
    subroutine bfs(self, start)
        class(Graph), intent(in) :: self
        integer, intent(in) :: start
        logical, dimension(:), allocatable :: visited
        integer, dimension(:), allocatable :: queue
        integer :: front, rear, i, v
        
        allocate(visited(self%vertices))
        allocate(queue(self%vertices))
        visited = .false.
        front = 1
        rear = 1
        
        visited(start) = .true.
        queue(rear) = start
        rear = rear + 1
        
        do while (front < rear)
            v = queue(front)
            front = front + 1
            print *, "Visited: ", v
            
            do i = 1, self%vertices
                if (self%adj_matrix(v, i) == 1 .and. .not. visited(i)) then
                    visited(i) = .true.
                    queue(rear) = i
                    rear = rear + 1
                end if
            end do
        end do
        
        deallocate(visited, queue)
    end subroutine bfs
    
    subroutine print_graph(self)
        class(Graph), intent(in) :: self
        integer :: i, j
        print *, "Adjacency Matrix:"
        do i = 1, self%vertices
            do j = 1, self%vertices
                write(*, '(I2)', advance='no') self%adj_matrix(i, j)
            end do
            print *
        end do
    end subroutine print_graph
end module graph

program test_graph
    use graph
    implicit none
    type(Graph) :: g
    
    call g%init(6)
    call g%add_edge(1, 2)
    call g%add_edge(1, 3)
    call g%add_edge(2, 4)
    call g%add_edge(3, 5)
    call g%add_edge(4, 6)
    call g%add_edge(5, 6)
    
    call g%print_graph()
    
    print *, "DFS starting from 1:"
    call g%dfs(1)
    
    print *, "BFS starting from 1:"
    call g%bfs(1)
end program test_graph

! Dijkstra's Algorithm
module dijkstra
    implicit none
contains
    subroutine dijkstra_algorithm(adj, n, src, dist)
        integer, intent(in) :: n, src
        integer, dimension(n, n), intent(in) :: adj
        integer, dimension(n), intent(out) :: dist
        logical, dimension(n) :: visited
        integer :: i, u, v, min_dist
        
        dist = huge(1)
        visited = .false.
        dist(src) = 0
        
        do i = 1, n
            u = -1
            min_dist = huge(1)
            do v = 1, n
                if (.not. visited(v) .and. dist(v) < min_dist) then
                    min_dist = dist(v)
                    u = v
                end if
            end do
            
            if (u == -1) exit
            visited(u) = .true.
            
            do v = 1, n
                if (.not. visited(v) .and. adj(u, v) > 0) then
                    if (dist(u) + adj(u, v) < dist(v)) then
                        dist(v) = dist(u) + adj(u, v)
                    end if
                end if
            end do
        end do
    end subroutine dijkstra_algorithm
end module dijkstra

program test_dijkstra
    use dijkstra
    implicit none
    integer, parameter :: n = 5
    integer, dimension(n, n) :: adj
    integer, dimension(n) :: dist
    integer :: i
    
    adj = 0
    adj(1, 2) = 10
    adj(1, 4) = 5
    adj(2, 3) = 1
    adj(2, 4) = 2
    adj(3, 5) = 4
    adj(4, 5) = 9
    adj(2, 1) = 10
    adj(4, 1) = 5
    adj(3, 2) = 1
    adj(4, 2) = 2
    adj(5, 3) = 4
    adj(5, 4) = 9
    
    call dijkstra_algorithm(adj, n, 1, dist)
    
    print *, "Shortest distances from 1:"
    do i = 1, n
        print *, "To ", i, ": ", dist(i)
    end do
end program test_dijkstra

! Bubble Sort
module sorts
contains
    subroutine bubble_sort(arr)
        integer, dimension(:), intent(inout) :: arr
        integer :: i, j, temp
        
        do i = 1, size(arr) - 1
            do j = 1, size(arr) - i
                if (arr(j) > arr(j + 1)) then
                    temp = arr(j)
                    arr(j) = arr(j + 1)
                    arr(j + 1) = temp
                end if
            end do
        end do
    end subroutine bubble_sort
    
    subroutine selection_sort(arr)
        integer, dimension(:), intent(inout) :: arr
        integer :: i, j, min_idx, temp
        
        do i = 1, size(arr) - 1
            min_idx = i
            do j = i + 1, size(arr)
                if (arr(j) < arr(min_idx)) then
                    min_idx = j
                end if
            end do
            if (min_idx /= i) then
                temp = arr(i)
                arr(i) = arr(min_idx)
                arr(min_idx) = temp
            end if
        end do
    end subroutine selection_sort
    
    subroutine insertion_sort(arr)
        integer, dimension(:), intent(inout) :: arr
        integer :: i, j, key
        
        do i = 2, size(arr)
            key = arr(i)
            j = i - 1
            do while (j >= 1 .and. arr(j) > key)
                arr(j + 1) = arr(j)
                j = j - 1
            end do
            arr(j + 1) = key
        end do
    end subroutine insertion_sort
end module sorts

program test_sorts
    use sorts
    implicit none
    integer, dimension(8) :: arr = [64, 34, 25, 12, 22, 11, 90, 1]
    
    print *, "Original: ", arr
    call bubble_sort(arr)
    print *, "Bubble sort: ", arr
    
    arr = [64, 34, 25, 12, 22, 11, 90, 1]
    call selection_sort(arr)
    print *, "Selection sort: ", arr
    
    arr = [64, 34, 25, 12, 22, 11, 90, 1]
    call insertion_sort(arr)
    print *, "Insertion sort: ", arr
end program test_sorts

! Matrix Operations
module matrix_ops
contains
    function matrix_multiply(a, b) result(c)
        real, dimension(:,:), intent(in) :: a, b
        real, dimension(size(a,1), size(b,2)) :: c
        integer :: i, j, k
        
        c = 0.0
        do i = 1, size(a, 1)
            do j = 1, size(b, 2)
                do k = 1, size(a, 2)
                    c(i, j) = c(i, j) + a(i, k) * b(k, j)
                end do
            end do
        end do
    end function matrix_multiply
    
    function matrix_transpose(a) result(b)
        real, dimension(:,:), intent(in) :: a
        real, dimension(size(a,2), size(a,1)) :: b
        integer :: i, j
        
        do i = 1, size(a, 1)
            do j = 1, size(a, 2)
                b(j, i) = a(i, j)
            end do
        end do
    end function matrix_transpose
end module matrix_ops

program test_matrix
    use matrix_ops
    implicit none
    real, dimension(3,3) :: a, b, c
    
    a = reshape([1.0, 2.0, 3.0, 4.0, 5.0, 6.0, 7.0, 8.0, 9.0], [3, 3])
    b = reshape([9.0, 8.0, 7.0, 6.0, 5.0, 4.0, 3.0, 2.0, 1.0], [3, 3])
    
    c = matrix_multiply(a, b)
    print *, "Matrix multiplication:"
    print *, c
    
    c = matrix_transpose(a)
    print *, "Transpose:"
    print *, c
end program test_matrix

! Numerical Integration (Trapezoidal Rule)
module integration
contains
    function trapezoidal(f, a, b, n) result(integral)
        interface
            function f(x) result(y)
                real, intent(in) :: x
                real :: y
            end function f
        end interface
        real, intent(in) :: a, b
        integer, intent(in) :: n
        real :: integral
        real :: h, x
        integer :: i
        
        h = (b - a) / n
        integral = (f(a) + f(b)) / 2.0
        
        do i = 1, n - 1
            x = a + i * h
            integral = integral + f(x)
        end do
        
        integral = integral * h
    end function trapezoidal
    
    function simpson(f, a, b, n) result(integral)
        interface
            function f(x) result(y)
                real, intent(in) :: x
                real :: y
            end function f
        end interface
        real, intent(in) :: a, b
        integer, intent(in) :: n
        real :: integral
        real :: h, x
        integer :: i
        
        h = (b - a) / n
        integral = f(a) + f(b)
        
        do i = 1, n - 1
            x = a + i * h
            if (mod(i, 2) == 0) then
                integral = integral + 2.0 * f(x)
            else
                integral = integral + 4.0 * f(x)
            end if
        end do
        
        integral = integral * h / 3.0
    end function simpson
end module integration

program test_integration
    use integration
    implicit none
    
    print *, "Trapezoidal: ", trapezoidal(f, 0.0, 1.0, 1000)
    print *, "Simpson: ", simpson(f, 0.0, 1.0, 1000)
    
contains
    function f(x) result(y)
        real, intent(in) :: x
        real :: y
        y = x * x
    end function f
end program test_integration

! Newton's Method
module numerical
contains
    subroutine newton(f, df, x0, tolerance, max_iter, result)
        interface
            function f(x) result(y)
                real, intent(in) :: x
                real :: y
            end function f
            function df(x) result(y)
                real, intent(in) :: x
                real :: y
            end function df
        end interface
        real, intent(in) :: x0, tolerance
        integer, intent(in) :: max_iter
        real, intent(out) :: result
        real :: x, fx, dfx
        integer :: i
        
        x = x0
        do i = 1, max_iter
            fx = f(x)
            dfx = df(x)
            if (abs(dfx) < 1.0e-10) then
                result = x
                return
            end if
            x = x - fx / dfx
            if (abs(fx) < tolerance) then
                result = x
                return
            end if
        end do
        result = x
    end subroutine newton
end module numerical

program test_newton
    use numerical
    implicit none
    real :: result
    
    call newton(f, df, 1.0, 1.0e-6, 100, result)
    print *, "Newton's method result: ", result
    
contains
    function f(x) result(y)
        real, intent(in) :: x
        real :: y
        y = x * x - 2.0
    end function f
    
    function df(x) result(y)
        real, intent(in) :: x
        real :: y
        y = 2.0 * x
    end function df
end program test_newton

! Linear Algebra - Gaussian Elimination
module linear_algebra
contains
    subroutine gaussian_elimination(a, b, x)
        real, dimension(:,:), intent(inout) :: a
        real, dimension(:), intent(inout) :: b
        real, dimension(:), intent(out) :: x
        integer :: n, i, j, k
        real :: factor, sum
        
        n = size(a, 1)
        
        ! Forward elimination
        do k = 1, n - 1
            do i = k + 1, n
                factor = a(i, k) / a(k, k)
                a(i, k:n) = a(i, k:n) - factor * a(k, k:n)
                b(i) = b(i) - factor * b(k)
            end do
        end do
        
        ! Back substitution
        x(n) = b(n) / a(n, n)
        do i = n - 1, 1, -1
            sum = b(i)
            do j = i + 1, n
                sum = sum - a(i, j) * x(j)
            end do
            x(i) = sum / a(i, i)
        end do
    end subroutine gaussian_elimination
end module linear_algebra

program test_gaussian
    use linear_algebra
    implicit none
    real, dimension(3,3) :: a
    real, dimension(3) :: b, x
    
    a = reshape([2.0, -1.0, 0.0, -1.0, 2.0, -1.0, 0.0, -1.0, 2.0], [3, 3])
    b = [1.0, 0.0, 1.0]
    
    call gaussian_elimination(a, b, x)
    print *, "Solution: ", x
end program test_gaussian

! Parallel Programming with OpenMP
program openmp_example
    use omp_lib
    implicit none
    integer :: i, n, thread_id
    real, dimension(:), allocatable :: arr
    real :: sum_val
    
    n = 10000000
    allocate(arr(n))
    arr = 1.0
    
    ! Parallel loop
    sum_val = 0.0
    !$omp parallel do reduction(+:sum_val) private(thread_id)
    do i = 1, n
        thread_id = omp_get_thread_num()
        sum_val = sum_val + arr(i)
    end do
    !$omp end parallel do
    
    print *, "Sum: ", sum_val
    
    ! Parallel sections
    !$omp parallel sections
    !$omp section
        print *, "Section 1: ", omp_get_thread_num()
    !$omp section
        print *, "Section 2: ", omp_get_thread_num()
    !$omp section
        print *, "Section 3: ", omp_get_thread_num()
    !$omp end parallel sections
    
    deallocate(arr)
end program openmp_example

! MPI Parallel Programming
! program mpi_example
!     use mpi
!     implicit none
!     integer :: ierr, rank, size
!     integer :: n, i
!     real, dimension(:), allocatable :: data
!     
!     call MPI_INIT(ierr)
!     call MPI_COMM_RANK(MPI_COMM_WORLD, rank, ierr)
!     call MPI_COMM_SIZE(MPI_COMM_WORLD, size, ierr)
!     
!     n = 100
!     allocate(data(n))
!     
!     if (rank == 0) then
!         data = 1.0
!     end if
!     
!     call MPI_BCAST(data, n, MPI_REAL, 0, MPI_COMM_WORLD, ierr)
!     
!     print *, "Rank ", rank, ": ", data(1:5)
!     
!     deallocate(data)
!     call MPI_FINALIZE(ierr)
! end program mpi_example

! Coarray Programming
program coarray_example
    implicit none
    integer, dimension(10)[*] :: coarray
    integer :: i, me
    
    me = this_image()
    
    ! Initialize
    do i = 1, 10
        coarray(i)[me] = i * me
    end do
    
    sync all
    
    ! Access from other images
    if (me == 1) then
        do i = 2, num_images()
            print *, "Image ", i, " coarray(1): ", coarray(1)[i]
        end do
    end if
    
    sync all
end program coarray_example

! Named Common Blocks
module common_blocks
    integer :: x, y
    common /block1/ x, y
end module common_blocks

program test_common
    use common_blocks
    implicit none
    
    x = 10
    y = 20
    
    print *, "x = ", x, " y = ", y
    call modify_values()
    print *, "After modify: x = ", x, " y = ", y
    
contains
    subroutine modify_values()
        integer :: x, y
        common /block1/ x, y
        x = 100
        y = 200
    end subroutine modify_values
end program test_common

! Pointer Arrays
program pointer_arrays
    implicit none
    integer, pointer :: p(:)
    integer, target :: arr(5) = [1, 2, 3, 4, 5]
    integer :: i
    
    p => arr
    print *, "p points to arr: ", p
    
    p = p * 2
    print *, "After p = p * 2: ", arr
    
    ! Pointer to array section
    p => arr(2:4)
    print *, "p points to arr(2:4): ", p
    
    ! Nullify pointer
    nullify(p)
end program pointer_arrays

! Derived Type with Allocatable Components
module complex_type
    implicit none
    type :: Poly
        integer :: degree
        real, dimension(:), allocatable :: coeff
    end type Poly
    
contains
    subroutine init_poly(p, coeff)
        type(Poly), intent(out) :: p
        real, dimension(:), intent(in) :: coeff
        p%degree = size(coeff) - 1
        allocate(p%coeff(p%degree + 1))
        p%coeff = coeff
    end subroutine init_poly
    
    function eval_poly(p, x) result(y)
        type(Poly), intent(in) :: p
        real, intent(in) :: x
        real :: y
        integer :: i
        y = 0.0
        do i = 1, p%degree + 1
            y = y + p%coeff(i) * x ** (i - 1)
        end do
    end function eval_poly
end module complex_type

program test_poly
    use complex_type
    implicit none
    type(Poly) :: p
    
    call init_poly(p, [1.0, 2.0, 3.0])
    print *, "Polynomial degree: ", p%degree
    print *, "p(2) = ", eval_poly(p, 2.0)
end program test_poly

! Abstract Interfaces
module abstract_interface
    implicit none
    
    ! Abstract interface
    abstract interface
        function func_interface(x) result(y)
            real, intent(in) :: x
            real :: y
        end function func_interface
    end interface
    
    type :: Integrator
        procedure(func_interface), pointer, nopass :: f
    contains
        procedure :: integrate
    end type Integrator
    
contains
    function integrate(self, a, b, n) result(integral)
        class(Integrator), intent(in) :: self
        real, intent(in) :: a, b
        integer, intent(in) :: n
        real :: integral
        real :: h, x
        integer :: i
        
        h = (b - a) / n
        integral = (self%f(a) + self%f(b)) / 2.0
        do i = 1, n - 1
            x = a + i * h
            integral = integral + self%f(x)
        end do
        integral = integral * h
    end function integrate
end module abstract_interface

module functions
    implicit none
contains
    function square(x) result(y)
        real, intent(in) :: x
        real :: y
        y = x * x
    end function square
    
    function cube(x) result(y)
        real, intent(in) :: x
        real :: y
        y = x * x * x
    end function cube
end module functions

program test_abstract
    use abstract_interface
    use functions
    implicit none
    type(Integrator) :: integrator
    
    integrator%f => square
    print *, "Square integral: ", integrator%integrate(0.0, 1.0, 1000)
    
    integrator%f => cube
    print *, "Cube integral: ", integrator%integrate(0.0, 1.0, 1000)
end program test_abstract

! Procedural Pointers
program procedural_pointers
    implicit none
    
    ! Define procedure pointer type
    interface
        function func_proc(x) result(y)
            real, intent(in) :: x
            real :: y
        end function func_proc
    end interface
    
    procedure(func_proc), pointer :: fp
    real :: result
    
    fp => square
    result = fp(5.0)
    print *, "Square of 5: ", result
    
    fp => cube
    result = fp(5.0)
    print *, "Cube of 5: ", result
    
contains
    function square(x) result(y)
        real, intent(in) :: x
        real :: y
        y = x * x
    end function square
    
    function cube(x) result(y)
        real, intent(in) :: x
        real :: y
        y = x * x * x
    end function cube
end program procedural_pointers

! F2008 Submodules
! module parent_module
!     implicit none
!     
!     interface
!         module subroutine print_message(msg)
!             character(len=*), intent(in) :: msg
!         end subroutine print_message
!     end interface
! end module parent_module
! 
! submodule(parent_module) child_submodule
! contains
!     module subroutine print_message(msg)
!         character(len=*), intent(in) :: msg
!         print *, "Message: ", msg
!     end subroutine print_message
! end submodule child_submodule
! 
! program test_submodule
!     use parent_module
!     implicit none
!     call print_message("Hello from submodule!")
! end program test_submodule

! IEEE Arithmetic
module ieee_arithmetic
    use, intrinsic :: ieee_arithmetic
contains
    subroutine check_nan(x)
        real, intent(in) :: x
        if (ieee_is_nan(x)) then
            print *, "Value is NaN"
        else
            print *, "Value is valid: ", x
        end if
    end subroutine check_nan
    
    subroutine check_inf(x)
        real, intent(in) :: x
        if (ieee_is_finite(x)) then
            print *, "Value is finite: ", x
        else if (ieee_is_negative_inf(x)) then
            print *, "Value is -Infinity"
        else
            print *, "Value is +Infinity"
        end if
    end subroutine check_inf
end module ieee_arithmetic

program test_ieee
    use ieee_arithmetic
    implicit none
    real :: x
    
    x = sqrt(-1.0)
    call check_nan(x)
    
    x = 1.0 / 0.0
    call check_inf(x)
end program test_ieee

! Exception Handling with IOSTAT
program exception_handling
    implicit none
    integer :: ios, unit, i
    real :: x
    
    ! File open error
    open(unit=10, file="nonexistent.txt", status="old", iostat=ios)
    if (ios /= 0) then
        print *, "Error opening file: ", ios
    else
        close(10)
    end if
    
    ! Read error
    open(unit=10, file="data.txt", status="old", action="read", iostat=ios)
    if (ios == 0) then
        do i = 1, 10
            read(10, *, iostat=ios) x
            if (ios < 0) then
                print *, "End of file reached"
                exit
            else if (ios > 0) then
                print *, "Error reading data"
                exit
            end if
            print *, x
        end do
        close(10)
    end if
end program exception_handling

! Memory Allocation Optimization
program memory_optimization
    implicit none
    integer :: n, i
    real, dimension(:), allocatable :: large_array
    
    ! Use contiguous memory
    n = 1000000
    allocate(large_array(n))
    large_array = 0.0
    
    ! Vector operations
    large_array = large_array + 1.0
    large_array = large_array * 2.0
    
    print *, "Array size: ", size(large_array)
    print *, "First element: ", large_array(1)
    print *, "Last element: ", large_array(n)
    
    deallocate(large_array)
end program memory_optimization

! Command Line Options
program cmd_options
    implicit none
    integer :: i, num_args
    character(len=100) :: arg
    logical :: verbose = .false.
    integer :: value = 0
    
    num_args = command_argument_count()
    
    do i = 1, num_args
        call get_command_argument(i, arg)
        select case(trim(arg))
        case("-v", "--verbose")
            verbose = .true.
        case("-n", "--number")
            if (i + 1 <= num_args) then
                call get_command_argument(i + 1, arg)
                read(arg, *) value
                i = i + 1
            end if
        case("-h", "--help")
            print *, "Usage: program [options]"
            print *, "  -v, --verbose  Verbose output"
            print *, "  -n, --number   Set a number"
            print *, "  -h, --help     Show this help"
            stop
        case default
            print *, "Unknown option: ", trim(arg)
        end select
    end do
    
    if (verbose) then
        print *, "Verbose mode enabled"
    end if
    print *, "Number value: ", value
end program cmd_options

! Environment Variables
program env_vars
    implicit none
    character(len=100) :: value
    integer :: status
    
    ! Get environment variable
    call get_environment_variable("PATH", value, status=status)
    if (status == 0) then
        print *, "PATH: ", trim(value)
    else
        print *, "PATH not found"
    end if
    
    ! Set environment variable
    call set_environment_variable("MY_VAR", "Hello World", status=status)
    if (status == 0) then
        print *, "MY_VAR set successfully"
    else
        print *, "Failed to set MY_VAR"
    end if
    
    ! Get all environment variables
    integer :: i, count
    character(len=100) :: name, env_value
    
    call get_environment_variable(i, name=name, value=env_value, status=status)
    do while (status == 0)
        print *, trim(name), "=", trim(env_value)
        i = i + 1
        call get_environment_variable(i, name=name, value=env_value, status=status)
    end do
end program env_vars

! System Clock Functions
program system_clock_example
    implicit none
    integer :: count, count_rate, count_max
    integer :: start_count, end_count
    real :: elapsed_time
    
    ! Get system clock rate
    call system_clock(count_rate=count_rate, count_max=count_max)
    print *, "Clock rate: ", count_rate, " ticks per second"
    print *, "Max count: ", count_max
    
    ! Measure elapsed time
    call system_clock(start_count)
    call sleep(2)  ! Sleep for 2 seconds
    call system_clock(end_count)
    
    elapsed_time = real(end_count - start_count) / real(count_rate)
    print *, "Elapsed time: ", elapsed_time, " seconds"
end program system_clock_example

! CPU Time Functions
program cpu_time_example
    implicit none
    real :: start_time, end_time, elapsed
    
    call cpu_time(start_time)
    
    ! Do some work
    call heavy_computation()
    
    call cpu_time(end_time)
    elapsed = end_time - start_time
    print *, "CPU time: ", elapsed, " seconds"
    
contains
    subroutine heavy_computation()
        integer :: i, j
        real :: x
        
        do i = 1, 1000000
            do j = 1, 100
                x = sqrt(real(i * j))
            end do
        end do
    end subroutine heavy_computation
end program cpu_time_example

! Random Number Generator
module random_generator
    implicit none
    integer :: seed = 12345
    
contains
    subroutine init_random_seed()
        integer :: i, n, clock
        integer, dimension(:), allocatable :: seed_array
        
        call random_seed(size=n)
        allocate(seed_array(n))
        
        call system_clock(count=clock)
        seed_array = clock + 37 * [(i, i = 1, n)]
        call random_seed(put=seed_array)
        deallocate(seed_array)
    end subroutine init_random_seed
    
    function random_uniform() result(x)
        real :: x
        call random_number(x)
    end function random_uniform
    
    function random_normal() result(x)
        real :: x, y, z
        real :: u1, u2
        
        call random_number(u1)
        call random_number(u2)
        x = sqrt(-2.0 * log(u1)) * cos(2.0 * 3.14159 * u2)
    end function random_normal
end module random_generator

program test_random
    use random_generator
    implicit none
    integer :: i
    
    call init_random_seed()
    
    print *, "Uniform random numbers:"
    do i = 1, 5
        print *, random_uniform()
    end do
    
    print *, "Normal random numbers:"
    do i = 1, 5
        print *, random_normal()
    end do
end program test_random

! String Manipulation Functions
module string_utils
contains
    function to_upper(str) result(upper)
        character(len=*), intent(in) :: str
        character(len=len(str)) :: upper
        integer :: i
        
        do i = 1, len(str)
            if (str(i:i) >= 'a' .and. str(i:i) <= 'z') then
                upper(i:i) = achar(iachar(str(i:i)) - 32)
            else
                upper(i:i) = str(i:i)
            end if
        end do
    end function to_upper
    
    function to_lower(str) result(lower)
        character(len=*), intent(in) :: str
        character(len=len(str)) :: lower
        integer :: i
        
        do i = 1, len(str)
            if (str(i:i) >= 'A' .and. str(i:i) <= 'Z') then
                lower(i:i) = achar(iachar(str(i:i)) + 32)
            else
                lower(i:i) = str(i:i)
            end if
        end do
    end function to_lower
    
    function reverse_string(str) result(reversed)
        character(len=*), intent(in) :: str
        character(len=len(str)) :: reversed
        integer :: i, n
        
        n = len(str)
        do i = 1, n
            reversed(i:i) = str(n - i + 1:n - i + 1)
        end do
    end function reverse_string
end module string_utils

program test_string_utils
    use string_utils
    implicit none
    character(len=20) :: str = "Hello World"
    
    print *, "Original: ", str
    print *, "Upper: ", to_upper(str)
    print *, "Lower: ", to_lower(str)
    print *, "Reverse: ", reverse_string(str)
end program test_string_utils

! Base64 Encoding/Decoding
module base64
contains
    function encode_base64(input) result(output)
        character(len=*), intent(in) :: input
        character(len=:), allocatable :: output
        character(len=64), parameter :: alphabet = &
            "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
        integer :: i, j, n, padding
        integer :: b1, b2, b3
        integer :: c1, c2, c3, c4
        
        n = len(input)
        padding = mod(n, 3)
        if (padding /= 0) padding = 3 - padding
        
        allocate(character(len=4 * ((n + 2) / 3)) :: output)
        j = 1
        do i = 1, n, 3
            b1 = ichar(input(i:i))
            b2 = ichar(input(i+1:i+1))
            b3 = ichar(input(i+2:i+2))
            
            c1 = ichar(shiftl(b1, 2) .or. ishft(b2, -4))
            c2 = ichar(ishft(b2, 4) .or. ishft(b3, -2))
            c3 = ichar(ishft(b3, 6))
            
            output(j:j) = alphabet(c1+1:c1+1)
            output(j+1:j+1) = alphabet(c2+1:c2+1)
            if (i+1 <= n) then
                output(j+2:j+2) = alphabet(c3+1:c3+1)
            else
                output(j+2:j+2) = "="
            end if
            if (i+2 <= n) then
                output(j+3:j+3) = alphabet(c4+1:c4+1)
            else
                output(j+3:j+3) = "="
            end if
            j = j + 4
        end do
    end function encode_base64
end module base64

program test_base64
    use base64
    implicit none
    character(len=100) :: input = "Hello, World!"
    character(len=:), allocatable :: encoded
    
    encoded = encode_base64(input)
    print *, "Encoded: ", encoded
end program test_base64

! JSON Parser (Simple)
module json_parser
    implicit none
    type :: JSONValue
        character(len=:), allocatable :: string
        real :: number
        logical :: boolean
        integer :: type  ! 1=string, 2=number, 3=boolean, 4=null
    end type JSONValue
    
    type :: JSONObject
        character(len=:), allocatable :: key
        type(JSONValue) :: value
        type(JSONObject), pointer :: next => null()
    end type JSONObject
    
contains
    function parse_json_string(str) result(obj)
        character(len=*), intent(in) :: str
        type(JSONObject), pointer :: obj
        ! Simple JSON parsing (not implemented fully)
        nullify(obj)
    end function parse_json_string
end module json_parser

! XML Parser (Simple)
module xml_parser
    implicit none
    type :: XMLNode
        character(len=:), allocatable :: name
        character(len=:), allocatable :: text
        type(XMLNode), pointer :: parent => null()
        type(XMLNode), pointer :: first_child => null()
        type(XMLNode), pointer :: next_sibling => null()
    end type XMLNode
    
contains
    function parse_xml_file(filename) result(root)
        character(len=*), intent(in) :: filename
        type(XMLNode), pointer :: root
        ! Simple XML parsing (not implemented fully)
        nullify(root)
    end function parse_xml_file
    
    subroutine free_xml_tree(node)
        type(XMLNode), pointer, intent(inout) :: node
        ! Free XML tree (not implemented fully)
    end subroutine free_xml_tree
end module xml_parser

! Hash Table Implementation
module hash_table
    implicit none
    integer, parameter :: TABLE_SIZE = 100
    
    type :: HashEntry
        character(len=20) :: key
        integer :: value
        type(HashEntry), pointer :: next => null()
    end type HashEntry
    
    type :: HashTable
        type(HashEntry), pointer :: table(TABLE_SIZE)
    contains
        procedure :: put
        procedure :: get
        procedure :: remove_entry
        procedure :: print_table
    end type HashTable
    
contains
    function hash(key) result(index)
        character(len=*), intent(in) :: key
        integer :: index
        integer :: i, hash_val
        
        hash_val = 0
        do i = 1, len_trim(key)
            hash_val = hash_val + ichar(key(i:i))
        end do
        index = mod(hash_val, TABLE_SIZE) + 1
    end function hash
    
    subroutine put(self, key, value)
        class(HashTable), intent(inout) :: self
        character(len=*), intent(in) :: key
        integer, intent(in) :: value
        integer :: index
        type(HashEntry), pointer :: entry
        
        index = hash(key)
        entry => self%table(index)
        
        do while (associated(entry))
            if (trim(entry%key) == trim(key)) then
                entry%value = value
                return
            end if
            entry => entry%next
        end do
        
        allocate(entry)
        entry%key = key
        entry%value = value
        entry%next => self%table(index)
        self%table(index) => entry
    end subroutine put
    
    function get(self, key) result(value)
        class(HashTable), intent(in) :: self
        character(len=*), intent(in) :: key
        integer :: value
        integer :: index
        type(HashEntry), pointer :: entry
        
        index = hash(key)
        entry => self%table(index)
        
        do while (associated(entry))
            if (trim(entry%key) == trim(key)) then
                value = entry%value
                return
            end if
            entry => entry%next
        end do
        value = -1
    end function get
    
    subroutine remove_entry(self, key)
        class(HashTable), intent(inout) :: self
        character(len=*), intent(in) :: key
        integer :: index
        type(HashEntry), pointer :: entry, prev
        
        index = hash(key)
        entry => self%table(index)
        prev => null()
        
        do while (associated(entry))
            if (trim(entry%key) == trim(key)) then
                if (associated(prev)) then
                    prev%next => entry%next
                else
                    self%table(index) => entry%next
                end if
                deallocate(entry)
                return
            end if
            prev => entry
            entry => entry%next
        end do
    end subroutine remove_entry
    
    subroutine print_table(self)
        class(HashTable), intent(in) :: self
        integer :: i
        type(HashEntry), pointer :: entry
        
        print *, "Hash Table:"
        do i = 1, TABLE_SIZE
            entry => self%table(i)
            if (associated(entry)) then
                print *, "Bucket ", i, ":"
                do while (associated(entry))
                    print *, "  ", trim(entry%key), " -> ", entry%value
                    entry => entry%next
                end do
            end if
        end do
    end subroutine print_table
end module hash_table

program test_hash_table
    use hash_table
    implicit none
    type(HashTable) :: ht
    
    call ht%put("Alice", 25)
    call ht%put("Bob", 30)
    call ht%put("Carol", 22)
    
    call ht%print_table()
    
    print *, "Bob's age: ", ht%get("Bob")
    print *, "David's age: ", ht%get("David")
    
    call ht%remove_entry("Bob")
    print *, "After removing Bob:"
    call ht%print_table()
end program test_hash_table

! Binary Search Tree with Operations
module bst
    implicit none
    type :: BSTNode
        integer :: value
        type(BSTNode), pointer :: left => null()
        type(BSTNode), pointer :: right => null()
    end type BSTNode
    
    type :: BST
        type(BSTNode), pointer :: root => null()
    contains
        procedure :: insert
        procedure :: search
        procedure :: inorder
        procedure :: preorder
        procedure :: postorder
        procedure :: min_value
        procedure :: max_value
        procedure :: height
        procedure :: destroy
    end type BST
    
contains
    recursive subroutine insert(self, value)
        class(BST), intent(inout) :: self
        integer, intent(in) :: value
        if (.not. associated(self%root)) then
            allocate(self%root)
            self%root%value = value
        else
            call insert_node(self%root, value)
        end if
    end subroutine insert
    
    recursive subroutine insert_node(node, value)
        type(BSTNode), pointer, intent(inout) :: node
        integer, intent(in) :: value
        if (value < node%value) then
            if (.not. associated(node%left)) then
                allocate(node%left)
                node%left%value = value
            else
                call insert_node(node%left, value)
            end if
        else
            if (.not. associated(node%right)) then
                allocate(node%right)
                node%right%value = value
            else
                call insert_node(node%right, value)
            end if
        end if
    end subroutine insert_node
    
    recursive function search(self, node, value) result(found)
        class(BST), intent(in) :: self
        type(BSTNode), pointer, intent(in) :: node
        integer, intent(in) :: value
        logical :: found
        
        if (.not. associated(node)) then
            found = .false.
        else if (node%value == value) then
            found = .true.
        else if (value < node%value) then
            found = self%search(node%left, value)
        else
            found = self%search(node%right, value)
        end if
    end function search
    
    recursive subroutine inorder(self, node)
        class(BST), intent(in) :: self
        type(BSTNode), pointer, intent(in) :: node
        if (associated(node)) then
            call self%inorder(node%left)
            print *, node%value
            call self%inorder(node%right)
        end if
    end subroutine inorder
    
    recursive subroutine preorder(self, node)
        class(BST), intent(in) :: self
        type(BSTNode), pointer, intent(in) :: node
        if (associated(node)) then
            print *, node%value
            call self%preorder(node%left)
            call self%preorder(node%right)
        end if
    end subroutine preorder
    
    recursive subroutine postorder(self, node)
        class(BST), intent(in) :: self
        type(BSTNode), pointer, intent(in) :: node
        if (associated(node)) then
            call self%postorder(node%left)
            call self%postorder(node%right)
            print *, node%value
        end if
    end subroutine postorder
    
    function min_value(self, node) result(min_val)
        class(BST), intent(in) :: self
        type(BSTNode), pointer, intent(in) :: node
        integer :: min_val
        if (associated(node%left)) then
            min_val = self%min_value(node%left)
        else
            min_val = node%value
        end if
    end function min_value
    
    function max_value(self, node) result(max_val)
        class(BST), intent(in) :: self
        type(BSTNode), pointer, intent(in) :: node
        integer :: max_val
        if (associated(node%right)) then
            max_val = self%max_value(node%right)
        else
            max_val = node%value
        end if
    end function max_value
    
    recursive function height(self, node) result(h)
        class(BST), intent(in) :: self
        type(BSTNode), pointer, intent(in) :: node
        integer :: h
        if (.not. associated(node)) then
            h = 0
        else
            h = 1 + max(self%height(node%left), self%height(node%right))
        end if
    end function height
    
    recursive subroutine destroy(self, node)
        class(BST), intent(inout) :: self
        type(BSTNode), pointer, intent(inout) :: node
        if (associated(node)) then
            call self%destroy(node%left)
            call self%destroy(node%right)
            deallocate(node)
        end if
    end subroutine destroy
end module bst

program test_bst
    use bst
    implicit none
    type(BST) :: tree
    
    call tree%insert(50)
    call tree%insert(30)
    call tree%insert(70)
    call tree%insert(20)
    call tree%insert(40)
    call tree%insert(60)
    call tree%insert(80)
    
    print *, "Inorder:"
    call tree%inorder(tree%root)
    
    print *, "Search 40: ", tree%search(tree%root, 40)
    print *, "Search 99: ", tree%search(tree%root, 99)
    print *, "Min: ", tree%min_value(tree%root)
    print *, "Max: ", tree%max_value(tree%root)
    print *, "Height: ", tree%height(tree%root)
    
    call tree%destroy(tree%root)
end program test_bst

! AVL Tree Implementation
module avl_tree
    implicit none
    type :: AVLNode
        integer :: value, height
        type(AVLNode), pointer :: left => null()
        type(AVLNode), pointer :: right => null()
    end type AVLNode
    
    type :: AVL
        type(AVLNode), pointer :: root => null()
    contains
        procedure :: insert
        procedure :: inorder
        procedure :: height
        procedure :: destroy
    end type AVL
    
contains
    function node_height(node) result(h)
        type(AVLNode), pointer, intent(in) :: node
        integer :: h
        if (associated(node)) then
            h = node%height
        else
            h = 0
        end if
    end function node_height
    
    function balance_factor(node) result(bf)
        type(AVLNode), pointer, intent(in) :: node
        integer :: bf
        if (associated(node)) then
            bf = node_height(node%left) - node_height(node%right)
        else
            bf = 0
        end if
    end function balance_factor
    
    subroutine update_height(node)
        type(AVLNode), pointer, intent(inout) :: node
        if (associated(node)) then
            node%height = 1 + max(node_height(node%left), node_height(node%right))
        end if
    end subroutine update_height
    
    subroutine rotate_right(node)
        type(AVLNode), pointer, intent(inout) :: node
        type(AVLNode), pointer :: new_root
        
        new_root => node%left
        node%left => new_root%right
        new_root%right => node
        call update_height(node)
        call update_height(new_root)
        node => new_root
    end subroutine rotate_right
    
    subroutine rotate_left(node)
        type(AVLNode), pointer, intent(inout) :: node
        type(AVLNode), pointer :: new_root
        
        new_root => node%right
        node%right => new_root%left
        new_root%left => node
        call update_height(node)
        call update_height(new_root)
        node => new_root
    end subroutine rotate_left
    
    recursive subroutine insert_node(node, value)
        type(AVLNode), pointer, intent(inout) :: node
        integer, intent(in) :: value
        integer :: bf
        
        if (.not. associated(node)) then
            allocate(node)
            node%value = value
            node%height = 1
            node%left => null()
            node%right => null()
            return
        end if
        
        if (value < node%value) then
            call insert_node(node%left, value)
        else if (value > node%value) then
            call insert_node(node%right, value)
        else
            return
        end if
        
        call update_height(node)
        bf = balance_factor(node)
        
        if (bf > 1 .and. value < node%left%value) then
            call rotate_right(node)
        else if (bf < -1 .and. value > node%right%value) then
            call rotate_left(node)
        else if (bf > 1 .and. value > node%left%value) then
            call rotate_left(node%left)
            call rotate_right(node)
        else if (bf < -1 .and. value < node%right%value) then
            call rotate_right(node%right)
            call rotate_left(node)
        end if
    end subroutine insert_node
    
    subroutine insert(self, value)
        class(AVL), intent(inout) :: self
        integer, intent(in) :: value
        call insert_node(self%root, value)
    end subroutine insert
    
    recursive subroutine inorder(self, node)
        class(AVL), intent(in) :: self
        type(AVLNode), pointer, intent(in) :: node
        if (associated(node)) then
            call self%inorder(node%left)
            print *, node%value
            call self%inorder(node%right)
        end if
    end subroutine inorder
    
    recursive function height(self, node) result(h)
        class(AVL), intent(in) :: self
        type(AVLNode), pointer, intent(in) :: node
        integer :: h
        if (.not. associated(node)) then
            h = 0
        else
            h = 1 + max(self%height(node%left), self%height(node%right))
        end if
    end function height
    
    recursive subroutine destroy(self, node)
        class(AVL), intent(inout) :: self
        type(AVLNode), pointer, intent(inout) :: node
        if (associated(node)) then
            call self%destroy(node%left)
            call self%destroy(node%right)
            deallocate(node)
        end if
    end subroutine destroy
end module avl_tree

program test_avl
    use avl_tree
    implicit none
    type(AVL) :: tree
    
    call tree%insert(10)
    call tree%insert(20)
    call tree%insert(30)
    call tree%insert(40)
    call tree%insert(50)
    call tree%insert(25)
    
    print *, "AVL Inorder:"
    call tree%inorder(tree%root)
    print *, "AVL Height: ", tree%height(tree%root)
    
    call tree%destroy(tree%root)
end program test_avl

! Priority Queue Implementation
module priority_queue
    implicit none
    type :: PQNode
        integer :: priority
        integer :: value
    end type PQNode
    
    type :: PriorityQueue
        type(PQNode), dimension(:), allocatable :: heap
        integer :: size = 0
    contains
        procedure :: enqueue
        procedure :: dequeue
        procedure :: peek
        procedure :: is_empty
        procedure :: print_queue
    end type PriorityQueue
    
contains
    subroutine enqueue(self, priority, value)
        class(PriorityQueue), intent(inout) :: self
        integer, intent(in) :: priority, value
        integer :: i, parent
        
        if (.not. allocated(self%heap)) then
            allocate(self%heap(10))
        end if
        
        if (self%size >= size(self%heap)) then
            call resize_heap(self)
        end if
        
        self%size = self%size + 1
        i = self%size
        self%heap(i)%priority = priority
        self%heap(i)%value = value
        
        do while (i > 1)
            parent = i / 2
            if (self%heap(parent)%priority <= self%heap(i)%priority) exit
            call swap(self%heap(parent), self%heap(i))
            i = parent
        end do
    end subroutine enqueue
    
    function dequeue(self) result(value)
        class(PriorityQueue), intent(inout) :: self
        integer :: value
        integer :: i, child
        
        if (self%is_empty()) then
            value = -1
            return
        end if
        
        value = self%heap(1)%value
        self%heap(1) = self%heap(self%size)
        self%size = self%size - 1
        i = 1
        
        do while (i * 2 <= self%size)
            child = i * 2
            if (child + 1 <= self%size) then
                if (self%heap(child + 1)%priority < self%heap(child)%priority) then
                    child = child + 1
                end if
            end if
            if (self%heap(i)%priority <= self%heap(child)%priority) exit
            call swap(self%heap(i), self%heap(child))
            i = child
        end do
    end function dequeue
    
    function peek(self) result(value)
        class(PriorityQueue), intent(in) :: self
        integer :: value
        if (self%is_empty()) then
            value = -1
        else
            value = self%heap(1)%value
        end if
    end function peek
    
    function is_empty(self) result(empty)
        class(PriorityQueue), intent(in) :: self
        logical :: empty
        empty = self%size == 0
    end function is_empty
    
    subroutine resize_heap(self)
        class(PriorityQueue), intent(inout) :: self
        type(PQNode), dimension(:), allocatable :: temp
        
        allocate(temp(size(self%heap) * 2))
        temp(1:self%size) = self%heap(1:self%size)
        call move_alloc(temp, self%heap)
    end subroutine resize_heap
    
    subroutine swap(a, b)
        type(PQNode), intent(inout) :: a, b
        type(PQNode) :: temp
        temp = a
        a = b
        b = temp
    end subroutine swap
    
    subroutine print_queue(self)
        class(PriorityQueue), intent(in) :: self
        integer :: i
        print *, "Priority Queue (priority, value):"
        do i = 1, self%size
            print *, self%heap(i)%priority, " -> ", self%heap(i)%value
        end do
    end subroutine print_queue
end module priority_queue

program test_pq
    use priority_queue
    implicit none
    type(PriorityQueue) :: pq
    
    call pq%enqueue(3, 10)
    call pq%enqueue(1, 20)
    call pq%enqueue(2, 30)
    call pq%enqueue(5, 40)
    call pq%enqueue(4, 50)
    
    call pq%print_queue()
    
    print *, "Peek: ", pq%peek()
    
    print *, "Dequeue order:"
    do while (.not. pq%is_empty())
        print *, pq%dequeue()
    end do
end program test_pq

! Fibonacci Heap (Simplified)
module fibonacci_heap
    implicit none
    type :: FibNode
        integer :: key
        integer :: degree = 0
        logical :: marked = .false.
        type(FibNode), pointer :: parent => null()
        type(FibNode), pointer :: child => null()
        type(FibNode), pointer :: left => null()
        type(FibNode), pointer :: right => null()
    end type FibNode
    
    type :: FibHeap
        type(FibNode), pointer :: min => null()
        integer :: n = 0
    contains
        procedure :: insert
        procedure :: extract_min
        procedure :: merge
        procedure :: is_empty
    end type FibHeap
    
contains
    subroutine insert(self, key)
        class(FibHeap), intent(inout) :: self
        integer, intent(in) :: key
        type(FibNode), pointer :: node
        
        allocate(node)
        node%key = key
        node%degree = 0
        node%marked = .false.
        node%parent => null()
        node%child => null()
        node%left => node
        node%right => node
        
        if (associated(self%min)) then
            node%right => self%min
            node%left => self%min%left
            self%min%left%right => node
            self%min%left => node
            if (key < self%min%key) then
                self%min => node
            end if
        else
            self%min => node
        end if
        self%n = self%n + 1
    end subroutine insert
    
    function extract_min(self) result(min_key)
        class(FibHeap), intent(inout) :: self
        integer :: min_key
        type(FibNode), pointer :: z, child, tmp
        
        if (.not. associated(self%min)) then
            min_key = -1
            return
        end if
        
        z => self%min
        min_key = z%key
        
        ! Add children to root list
        if (associated(z%child)) then
            child => z%child
            do
                tmp => child%right
                child%parent => null()
                child%left => z%left
                child%right => z
                z%left%right => child
                z%left => child
                child => tmp
                if (child == z%child) exit
            end do
        end if
        
        ! Remove z from root list
        if (z%right == z) then
            self%min => null()
        else
            z%left%right => z%right
            z%right%left => z%left
            self%min => z%right
            call consolidate(self)
        end if
        
        self%n = self%n - 1
        deallocate(z)
    end function extract_min
    
    subroutine consolidate(self)
        class(FibHeap), intent(inout) :: self
        ! Simplified consolidation (not fully implemented)
    end subroutine consolidate
    
    function is_empty(self) result(empty)
        class(FibHeap), intent(in) :: self
        logical :: empty
        empty = .not. associated(self%min)
    end function is_empty
end module fibonacci_heap

program test_fib_heap
    use fibonacci_heap
    implicit none
    type(FibHeap) :: fh
    
    call fh%insert(10)
    call fh%insert(20)
    call fh%insert(30)
    call fh%insert(5)
    call fh%insert(15)
    
    print *, "Extract min: ", fh%extract_min()
    print *, "Extract min: ", fh%extract_min()
end program test_fib_heap

! Red-Black Tree (Simplified)
module red_black_tree
    implicit none
    type :: RBNode
        integer :: key
        logical :: red = .true.
        type(RBNode), pointer :: left => null()
        type(RBNode), pointer :: right => null()
        type(RBNode), pointer :: parent => null()
    end type RBNode
    
    type :: RBTree
        type(RBNode), pointer :: root => null()
    contains
        procedure :: insert
        procedure :: inorder
    end type RBTree
    
contains
    subroutine rotate_left(self, node)
        class(RBTree), intent(inout) :: self
        type(RBNode), pointer, intent(inout) :: node
        type(RBNode), pointer :: child
        
        child => node%right
        node%right => child%left
        if (associated(child%left)) child%left%parent => node
        child%parent => node%parent
        if (.not. associated(node%parent)) then
            self%root => child
        else if (node == node%parent%left) then
            node%parent%left => child
        else
            node%parent%right => child
        end if
        child%left => node
        node%parent => child
    end subroutine rotate_left
    
    subroutine rotate_right(self, node)
        class(RBTree), intent(inout) :: self
        type(RBNode), pointer, intent(inout) :: node
        type(RBNode), pointer :: child
        
        child => node%left
        node%left => child%right
        if (associated(child%right)) child%right%parent => node
        child%parent => node%parent
        if (.not. associated(node%parent)) then
            self%root => child
        else if (node == node%parent%right) then
            node%parent%right => child
        else
            node%parent%left => child
        end if
        child%right => node
        node%parent => child
    end subroutine rotate_right
    
    subroutine insert_fixup(self, node)
        class(RBTree), intent(inout) :: self
        type(RBNode), pointer, intent(inout) :: node
        type(RBNode), pointer :: parent, grandparent, uncle
        
        do while (associated(node%parent) .and. node%parent%red)
            parent => node%parent
            grandparent => parent%parent
            if (associated(grandparent)) then
                if (parent == grandparent%left) then
                    uncle => grandparent%right
                    if (associated(uncle) .and. uncle%red) then
                        parent%red = .false.
                        uncle%red = .false.
                        grandparent%red = .true.
                        node => grandparent
                    else
                        if (node == parent%right) then
                            node => parent
                            call rotate_left(self, node)
                            parent => node%parent
                        end if
                        parent%red = .false.
                        grandparent%red = .true.
                        call rotate_right(self, grandparent)
                    end if
                else
                    uncle => grandparent%left
                    if (associated(uncle) .and. uncle%red) then
                        parent%red = .false.
                        uncle%red = .false.
                        grandparent%red = .true.
                        node => grandparent
                    else
                        if (node == parent%left) then
                            node => parent
                            call rotate_right(self, node)
                            parent => node%parent
                        end if
                        parent%red = .false.
                        grandparent%red = .true.
                        call rotate_left(self, grandparent)
                    end if
                end if
            end if
        end do
        self%root%red = .false.
    end subroutine insert_fixup
    
    subroutine insert(self, key)
        class(RBTree), intent(inout) :: self
        integer, intent(in) :: key
        type(RBNode), pointer :: node, current, parent
        
        allocate(node)
        node%key = key
        node%red = .true.
        node%left => null()
        node%right => null()
        node%parent => null()
        
        if (.not. associated(self%root)) then
            self%root => node
            node%red = .false.
            return
        end if
        
        current => self%root
        parent => null()
        do while (associated(current))
            parent => current
            if (key < current%key) then
                current => current%left
            else
                current => current%right
            end if
        end do
        
        node%parent => parent
        if (key < parent%key) then
            parent%left => node
        else
            parent%right => node
        end if
        
        call insert_fixup(self, node)
    end subroutine insert
    
    recursive subroutine inorder(self, node)
        class(RBTree), intent(in) :: self
        type(RBNode), pointer, intent(in) :: node
        if (associated(node)) then
            call self%inorder(node%left)
            print *, node%key, " (", merge("R", "B", node%red), ")"
            call self%inorder(node%right)
        end if
    end subroutine inorder
end module red_black_tree

program test_rb_tree
    use red_black_tree
    implicit none
    type(RBTree) :: tree
    
    call tree%insert(10)
    call tree%insert(20)
    call tree%insert(30)
    call tree%insert(40)
    call tree%insert(50)
    call tree%insert(25)
    
    print *, "Red-Black Tree Inorder:"
    call tree%inorder(tree%root)
end program test_rb_tree

! B-Tree Implementation
module btree
    implicit none
    integer, parameter :: T = 2  ! Minimum degree
    
    type :: BTreeNode
        integer :: n = 0
        logical :: leaf = .true.
        integer, dimension(2*T-1) :: keys
        type(BTreeNode), pointer, dimension(2*T) :: children => null()
    end type BTreeNode
    
    type :: BTree
        type(BTreeNode), pointer :: root => null()
    contains
        procedure :: insert
        procedure :: search
        procedure :: inorder
        procedure :: destroy
    end type BTree
    
contains
    subroutine split_child(self, node, i)
        class(BTree), intent(inout) :: self
        type(BTreeNode), pointer, intent(inout) :: node
        integer, intent(in) :: i
        type(BTreeNode), pointer :: y, z
        
        y => node%children(i)
        allocate(z)
        z%leaf = y%leaf
        z%n = T - 1
        
        ! Copy keys to z
        z%keys(1:T-1) = y%keys(T+1:2*T-1)
        
        ! Copy children if not leaf
        if (.not. y%leaf) then
            allocate(z%children(2*T))
            z%children(1:T) = y%children(T+1:2*T)
        end if
        
        y%n = T - 1
        
        ! Shift children in node
        do j = node%n + 1, i + 1, -1
            node%children(j+1) => node%children(j)
        end do
        node%children(i+1) => z
        
        ! Shift keys in node
        do j = node%n, i, -1
            node%keys(j+1) = node%keys(j)
        end do
        node%keys(i) = y%keys(T)
        node%n = node%n + 1
    end subroutine split_child
    
    subroutine insert_non_full(self, node, key)
        class(BTree), intent(inout) :: self
        type(BTreeNode), pointer, intent(inout) :: node
        integer, intent(in) :: key
        integer :: i
        
        if (node%leaf) then
            i = node%n
            do while (i >= 1 .and. key < node%keys(i))
                node%keys(i+1) = node%keys(i)
                i = i - 1
            end do
            node%keys(i+1) = key
            node%n = node%n + 1
        else
            i = node%n
            do while (i >= 1 .and. key < node%keys(i))
                i = i - 1
            end do
            i = i + 1
            if (node%children(i)%n == 2*T - 1) then
                call split_child(self, node, i)
                if (key > node%keys(i)) then
                    i = i + 1
                end if
            end if
            call insert_non_full(self, node%children(i), key)
        end if
    end subroutine insert_non_full
    
    subroutine insert(self, key)
        class(BTree), intent(inout) :: self
        integer, intent(in) :: key
        type(BTreeNode), pointer :: new_root
        
        if (.not. associated(self%root)) then
            allocate(self%root)
            self%root%leaf = .true.
            self%root%n = 0
            allocate(self%root%children(2*T))
        end if
        
        if (self%root%n == 2*T - 1) then
            allocate(new_root)
            new_root%leaf = .false.
            new_root%n = 0
            allocate(new_root%children(2*T))
            new_root%children(1) => self%root
            call split_child(self, new_root, 1)
            self%root => new_root
        end if
        
        call insert_non_full(self, self%root, key)
    end subroutine insert
    
    recursive function search(self, node, key) result(found)
        class(BTree), intent(in) :: self
        type(BTreeNode), pointer, intent(in) :: node
        integer, intent(in) :: key
        logical :: found
        integer :: i
        
        if (.not. associated(node)) then
            found = .false.
            return
        end if
        
        i = 1
        do while (i <= node%n .and. key > node%keys(i))
            i = i + 1
        end do
        
        if (i <= node%n .and. key == node%keys(i)) then
            found = .true.
        else if (node%leaf) then
            found = .false.
        else
            found = self%search(node%children(i), key)
        end if
    end function search
    
    recursive subroutine inorder(self, node)
        class(BTree), intent(in) :: self
        type(BTreeNode), pointer, intent(in) :: node
        integer :: i
        
        if (associated(node)) then
            do i = 1, node%n
                call self%inorder(node%children(i))
                print *, node%keys(i)
            end do
            call self%inorder(node%children(node%n + 1))
        end if
    end subroutine inorder
    
    recursive subroutine destroy(self, node)
        class(BTree), intent(inout) :: self
        type(BTreeNode), pointer, intent(inout) :: node
        integer :: i
        
        if (associated(node)) then
            do i = 1, node%n + 1
                call self%destroy(node%children(i))
            end do
            if (associated(node%children)) deallocate(node%children)
            deallocate(node)
        end if
    end subroutine destroy
end module btree

program test_btree
    use btree
    implicit none
    type(BTree) :: tree
    
    call tree%insert(10)
    call tree%insert(20)
    call tree%insert(30)
    call tree%insert(40)
    call tree%insert(50)
    call tree%insert(60)
    call tree%insert(70)
    call tree%insert(80)
    call tree%insert(90)
    
    print *, "B-Tree Inorder:"
    call tree%inorder(tree%root)
    
    print *, "Search 40: ", tree%search(tree%root, 40)
    print *, "Search 100: ", tree%search(tree%root, 100)
    
    call tree%destroy(tree%root)
end program test_btree

! Graph Adjacency List
module graph_adj_list
    implicit none
    type :: Edge
        integer :: dest
        integer :: weight
        type(Edge), pointer :: next => null()
    end type Edge
    
    type :: Graph
        integer :: vertices
        type(Edge), pointer, dimension(:), allocatable :: adj_list
    contains
        procedure :: init
        procedure :: add_edge
        procedure :: print_graph
        procedure :: dfs
        procedure :: bfs
    end type Graph
    
contains
    subroutine init(self, v)
        class(Graph), intent(inout) :: self
        integer, intent(in) :: v
        self%vertices = v
        allocate(self%adj_list(v))
        nullify(self%adj_list)
    end subroutine init
    
    subroutine add_edge(self, u, v, w)
        class(Graph), intent(inout) :: self
        integer, intent(in) :: u, v, w
        type(Edge), pointer :: new_edge
        
        allocate(new_edge)
        new_edge%dest = v
        new_edge%weight = w
        new_edge%next => self%adj_list(u)
        self%adj_list(u) => new_edge
        
        ! For undirected graph
        allocate(new_edge)
        new_edge%dest = u
        new_edge%weight = w
        new_edge%next => self%adj_list(v)
        self%adj_list(v) => new_edge
    end subroutine add_edge
    
    subroutine print_graph(self)
        class(Graph), intent(in) :: self
        type(Edge), pointer :: current
        integer :: i
        
        do i = 1, self%vertices
            print *, "Vertex ", i, ":"
            current => self%adj_list(i)
            do while (associated(current))
                print *, "  -> ", current%dest, " (weight: ", current%weight, ")"
                current => current%next
            end do
        end do
    end subroutine print_graph
    
    recursive subroutine dfs_recursive(self, v, visited)
        class(Graph), intent(in) :: self
        integer, intent(in) :: v
        logical, dimension(:), intent(inout) :: visited
        type(Edge), pointer :: current
        
        visited(v) = .true.
        print *, "Visited: ", v
        
        current => self%adj_list(v)
        do while (associated(current))
            if (.not. visited(current%dest)) then
                call self%dfs_recursive(current%dest, visited)
            end if
            current => current%next
        end do
    end subroutine dfs_recursive
    
    subroutine dfs(self, start)
        class(Graph), intent(in) :: self
        integer, intent(in) :: start
        logical, dimension(:), allocatable :: visited
        allocate(visited(self%vertices))
        visited = .false.
        call self%dfs_recursive(start, visited)
        deallocate(visited)
    end subroutine dfs
    
    subroutine bfs(self, start)
        class(Graph), intent(in) :: self
        integer, intent(in) :: start
        logical, dimension(:), allocatable :: visited
        integer, dimension(:), allocatable :: queue
        integer :: front, rear, v
        type(Edge), pointer :: current
        
        allocate(visited(self%vertices))
        allocate(queue(self%vertices))
        visited = .false.
        front = 1
        rear = 1
        
        visited(start) = .true.
        queue(rear) = start
        rear = rear + 1
        
        do while (front < rear)
            v = queue(front)
            front = front + 1
            print *, "Visited: ", v
            
            current => self%adj_list(v)
            do while (associated(current))
                if (.not. visited(current%dest)) then
                    visited(current%dest) = .true.
                    queue(rear) = current%dest
                    rear = rear + 1
                end if
                current => current%next
            end do
        end do
        
        deallocate(visited, queue)
    end subroutine bfs
end module graph_adj_list

program test_graph_adj
    use graph_adj_list
    implicit none
    type(Graph) :: g
    
    call g%init(6)
    call g%add_edge(1, 2, 10)
    call g%add_edge(1, 3, 5)
    call g%add_edge(2, 4, 2)
    call g%add_edge(3, 5, 4)
    call g%add_edge(4, 6, 9)
    call g%add_edge(5, 6, 3)
    
    call g%print_graph()
    
    print *, "DFS from 1:"
    call g%dfs(1)
    
    print *, "BFS from 1:"
    call g%bfs(1)
end program test_graph_adj

! Topological Sort
module topological_sort
    implicit none
    type :: Graph
        integer :: vertices
        integer, dimension(:,:), allocatable :: adj_matrix
    contains
        procedure :: init
        procedure :: add_edge
        procedure :: topological_sort
    end type Graph
    
contains
    subroutine init(self, v)
        class(Graph), intent(inout) :: self
        integer, intent(in) :: v
        self%vertices = v
        allocate(self%adj_matrix(v, v))
        self%adj_matrix = 0
    end subroutine init
    
    subroutine add_edge(self, u, v)
        class(Graph), intent(inout) :: self
        integer, intent(in) :: u, v
        self%adj_matrix(u, v) = 1
    end subroutine add_edge
    
    subroutine topological_sort(self, order)
        class(Graph), intent(in) :: self
        integer, dimension(:), intent(out) :: order
        integer :: i, j, k, count
        logical, dimension(:), allocatable :: visited
        integer, dimension(:), allocatable :: in_degree
        
        allocate(visited(self%vertices))
        allocate(in_degree(self%vertices))
        visited = .false.
        in_degree = 0
        
        ! Calculate indegree
        do i = 1, self%vertices
            do j = 1, self%vertices
                if (self%adj_matrix(j, i) == 1) then
                    in_degree(i) = in_degree(i) + 1
                end if
            end do
        end do
        
        count = 0
        do while (count < self%vertices)
            do i = 1, self%vertices
                if (in_degree(i) == 0 .and. .not. visited(i)) then
                    visited(i) = .true.
                    count = count + 1
                    order(count) = i
                    
                    do j = 1, self%vertices
                        if (self%adj_matrix(i, j) == 1) then
                            in_degree(j) = in_degree(j) - 1
                        end if
                    end do
                    
                    exit
                end if
            end do
        end do
        
        deallocate(visited, in_degree)
    end subroutine topological_sort
end module topological_sort

program test_topo_sort
    use topological_sort
    implicit none
    type(Graph) :: g
    integer, dimension(6) :: order
    integer :: i
    
    call g%init(6)
    call g%add_edge(5, 2)
    call g%add_edge(5, 0)
    call g%add_edge(4, 0)
    call g%add_edge(4, 1)
    call g%add_edge(2, 3)
    call g%add_edge(3, 1)
    
    call g%topological_sort(order)
    
    print *, "Topological Order:"
    do i = 1, 6
        print *, order(i)
    end do
end program test_topo_sort

! Shortest Path - Bellman-Ford
module bellman_ford
    implicit none
    type :: Edge
        integer :: u, v, weight
    end type Edge
    
    type :: Graph
        integer :: vertices, edges_count
        type(Edge), dimension(:), allocatable :: edges
    contains
        procedure :: init
        procedure :: add_edge
        procedure :: bellman_ford
    end type Graph
    
contains
    subroutine init(self, v)
        class(Graph), intent(inout) :: self
        integer, intent(in) :: v
        self%vertices = v
        self%edges_count = 0
        allocate(self%edges(v * v))
    end subroutine init
    
    subroutine add_edge(self, u, v, w)
        class(Graph), intent(inout) :: self
        integer, intent(in) :: u, v, w
        self%edges_count = self%edges_count + 1
        self%edges(self%edges_count) = Edge(u, v, w)
    end subroutine add_edge
    
    subroutine bellman_ford(self, src, dist)
        class(Graph), intent(in) :: self
        integer, intent(in) :: src
        integer, dimension(:), intent(out) :: dist
        integer :: i, j
        logical :: updated
        
        dist = 999999
        dist(src) = 0
        
        do i = 1, self%vertices - 1
            updated = .false.
            do j = 1, self%edges_count
                if (dist(self%edges(j)%u) + self%edges(j)%weight < dist(self%edges(j)%v)) then
                    dist(self%edges(j)%v) = dist(self%edges(j)%u) + self%edges(j)%weight
                    updated = .true.
                end if
            end do
            if (.not. updated) exit
        end do
        
        ! Check for negative cycles
        do j = 1, self%edges_count
            if (dist(self%edges(j)%u) + self%edges(j)%weight < dist(self%edges(j)%v)) then
                print *, "Negative cycle detected!"
                dist = -1
                return
            end if
        end do
    end subroutine bellman_ford
end module bellman_ford

program test_bellman_ford
    use bellman_ford
    implicit none
    type(Graph) :: g
    integer, dimension(5) :: dist
    
    call g%init(5)
    call g%add_edge(1, 2, -1)
    call g%add_edge(1, 3, 4)
    call g%add_edge(2, 3, 3)
    call g%add_edge(2, 4, 2)
    call g%add_edge(2, 5, 2)
    call g%add_edge(4, 3, 5)
    call g%add_edge(4, 2, 1)
    call g%add_edge(5, 4, -3)
    
    call g%bellman_ford(1, dist)
    
    print *, "Distances from 1:"
    do i = 1, 5
        print *, "To ", i, ": ", dist(i)
    end do
end program test_bellman_ford

! Floyd-Warshall Algorithm
module floyd_warshall
    implicit none
contains
    subroutine floyd_warshall(dist, n)
        integer, intent(in) :: n
        integer, dimension(n, n), intent(inout) :: dist
        integer :: i, j, k
        
        do k = 1, n
            do i = 1, n
                do j = 1, n
                    if (dist(i, k) + dist(k, j) < dist(i, j)) then
                        dist(i, j) = dist(i, k) + dist(k, j)
                    end if
                end do
            end do
        end do
    end subroutine floyd_warshall
end module floyd_warshall

program test_floyd_warshall
    use floyd_warshall
    implicit none
    integer, parameter :: INF = 999999
    integer, dimension(4, 4) :: dist
    integer :: i, j
    
    dist = reshape([0, 3, INF, 7, 8, 0, 2, INF, 5, INF, 0, 1, 2, INF, INF, 0], [4, 4])
    
    call floyd_warshall(dist, 4)
    
    print *, "All-pairs shortest paths:"
    do i = 1, 4
        do j = 1, 4
            write(*, '(I6)', advance='no') dist(i, j)
        end do
        print *
    end do
end program test_floyd_warshall

! Prim's Algorithm
module prim
    implicit none
    type :: Graph
        integer :: vertices
        integer, dimension(:,:), allocatable :: adj
    contains
        procedure :: init
        procedure :: add_edge
        procedure :: prim_mst
    end type Graph
    
contains
    subroutine init(self, v)
        class(Graph), intent(inout) :: self
        integer, intent(in) :: v
        self%vertices = v
        allocate(self%adj(v, v))
        self%adj = 0
    end subroutine init
    
    subroutine add_edge(self, u, v, w)
        class(Graph), intent(inout) :: self
        integer, intent(in) :: u, v, w
        self%adj(u, v) = w
        self%adj(v, u) = w
    end subroutine add_edge
    
    subroutine prim_mst(self, parent, cost)
        class(Graph), intent(in) :: self
        integer, dimension(:), intent(out) :: parent
        integer, intent(out) :: cost
        integer, dimension(:), allocatable :: key
        logical, dimension(:), allocatable :: in_mst
        integer :: i, j, min_key, min_index
        
        allocate(key(self%vertices))
        allocate(in_mst(self%vertices))
        key = 999999
        in_mst = .false.
        key(1) = 0
        parent(1) = 0
        
        do i = 1, self%vertices
            min_key = 999999
            min_index = -1
            do j = 1, self%vertices
                if (.not. in_mst(j) .and. key(j) < min_key) then
                    min_key = key(j)
                    min_index = j
                end if
            end do
            
            if (min_index == -1) exit
            in_mst(min_index) = .true.
            
            do j = 1, self%vertices
                if (.not. in_mst(j) .and. self%adj(min_index, j) > 0 .and. &
                    self%adj(min_index, j) < key(j)) then
                    key(j) = self%adj(min_index, j)
                    parent(j) = min_index
                end if
            end do
        end do
        
        cost = sum(key(2:self%vertices))
        deallocate(key, in_mst)
    end subroutine prim_mst
end module prim

program test_prim
    use prim
    implicit none
    type(Graph) :: g
    integer, dimension(5) :: parent
    integer :: cost, i
    
    call g%init(5)
    call g%add_edge(1, 2, 2)
    call g%add_edge(1, 4, 6)
    call g%add_edge(2, 3, 3)
    call g%add_edge(2, 4, 8)
    call g%add_edge(2, 5, 5)
    call g%add_edge(3, 5, 7)
    call g%add_edge(4, 5, 9)
    
    call g%prim_mst(parent, cost)
    
    print *, "MST Cost: ", cost
    print *, "Edges:"
    do i = 2, 5
        print *, parent(i), " -- ", i
    end do
end program test_prim

! Kruskal's Algorithm
module kruskal
    implicit none
    type :: Edge
        integer :: u, v, weight
    end type Edge
    
    type :: Graph
        integer :: vertices, edges_count
        type(Edge), dimension(:), allocatable :: edges
    contains
        procedure :: init
        procedure :: add_edge
        procedure :: kruskal_mst
    end type Graph
    
contains
    subroutine init(self, v)
        class(Graph), intent(inout) :: self
        integer, intent(in) :: v
        self%vertices = v
        self%edges_count = 0
        allocate(self%edges(v * v))
    end subroutine init
    
    subroutine add_edge(self, u, v, w)
        class(Graph), intent(inout) :: self
        integer, intent(in) :: u, v, w
        self%edges_count = self%edges_count + 1
        self%edges(self%edges_count) = Edge(u, v, w)
    end subroutine add_edge
    
    subroutine kruskal_mst(self, parent, cost)
        class(Graph), intent(in) :: self
        integer, dimension(:), intent(out) :: parent
        integer, intent(out) :: cost
        integer, dimension(:), allocatable :: set_parent, rank
        integer :: i, j, count, pu, pv
        integer :: temp_u, temp_v, temp_w
        
        allocate(set_parent(self%vertices))
        allocate(rank(self%vertices))
        
        do i = 1, self%vertices
            set_parent(i) = i
            rank(i) = 0
        end do
        
        ! Sort edges by weight
        do i = 1, self%edges_count - 1
            do j = i + 1, self%edges_count
                if (self%edges(j)%weight < self%edges(i)%weight) then
                    temp_u = self%edges(i)%u
                    temp_v = self%edges(i)%v
                    temp_w = self%edges(i)%weight
                    self%edges(i) = self%edges(j)
                    self%edges(j) = Edge(temp_u, temp_v, temp_w)
                end if
            end do
        end do
        
        cost = 0
        count = 0
        
        do i = 1, self%edges_count
            pu = find(set_parent, self%edges(i)%u)
            pv = find(set_parent, self%edges(i)%v)
            
            if (pu /= pv) then
                parent(count + 1) = self%edges(i)%u
                parent(count + 2) = self%edges(i)%v
                cost = cost + self%edges(i)%weight
                count = count + 1
                call union(set_parent, rank, pu, pv)
            end if
            
            if (count == self%vertices - 1) exit
        end do
        
        deallocate(set_parent, rank)
    contains
        recursive function find(parent, x) result(root)
            integer, dimension(:), intent(inout) :: parent
            integer, intent(in) :: x
            integer :: root
            if (parent(x) /= x) then
                parent(x) = find(parent, parent(x))
            end if
            root = parent(x)
        end function find
        
        subroutine union(parent, rank, x, y)
            integer, dimension(:), intent(inout) :: parent, rank
            integer, intent(in) :: x, y
            integer :: x_root, y_root
            
            x_root = find(parent, x)
            y_root = find(parent, y)
            
            if (rank(x_root) < rank(y_root)) then
                parent(x_root) = y_root
            else if (rank(x_root) > rank(y_root)) then
                parent(y_root) = x_root
            else
                parent(y_root) = x_root
                rank(x_root) = rank(x_root) + 1
            end if
        end subroutine union
    end subroutine kruskal_mst
end module kruskal

program test_kruskal
    use kruskal
    implicit none
    type(Graph) :: g
    integer, dimension(8) :: parent
    integer :: cost, i
    
    call g%init(4)
    call g%add_edge(1, 2, 10)
    call g%add_edge(1, 3, 6)
    call g%add_edge(1, 4, 5)
    call g%add_edge(2, 4, 15)
    call g%add_edge(3, 4, 4)
    
    call g%kruskal_mst(parent, cost)
    
    print *, "MST Cost: ", cost
    print *, "Edges:"
    do i = 1, 3
        print *, parent(i*2-1), " -- ", parent(i*2)
    end do
end program test_kruskal

! Longest Common Subsequence
module lcs
contains
    function lcs_length(a, b) result(length)
        character(len=*), intent(in) :: a, b
        integer :: length
        integer :: m, n, i, j
        integer, dimension(:,:), allocatable :: dp
        
        m = len(a)
        n = len(b)
        allocate(dp(m+1, n+1))
        dp = 0
        
        do i = 1, m
            do j = 1, n
                if (a(i:i) == b(j:j)) then
                    dp(i+1, j+1) = dp(i, j) + 1
                else
                    dp(i+1, j+1) = max(dp(i, j+1), dp(i+1, j))
                end if
            end do
        end do
        
        length = dp(m+1, n+1)
        deallocate(dp)
    end function lcs_length
end module lcs

program test_lcs
    use lcs
    implicit none
    character(len=20) :: a = "ABCBDAB"
    character(len=20) :: b = "BDCAB"
    
    print *, "LCS Length: ", lcs_length(a, b)
end program test_lcs

! Knapsack Problem
module knapsack
contains
    function knapsack_01(weights, values, capacity) result(max_value)
        integer, dimension(:), intent(in) :: weights, values
        integer, intent(in) :: capacity
        integer :: max_value
        integer :: n, i, j
        integer, dimension(:,:), allocatable :: dp
        
        n = size(weights)
        allocate(dp(n+1, capacity+1))
        dp = 0
        
        do i = 1, n
            do j = 0, capacity
                if (weights(i) <= j) then
                    dp(i+1, j+1) = max(dp(i, j+1), dp(i, j - weights(i) + 1) + values(i))
                else
                    dp(i+1, j+1) = dp(i, j+1)
                end if
            end do
        end do
        
        max_value = dp(n+1, capacity+1)
        deallocate(dp)
    end function knapsack_01
end module knapsack

program test_knapsack
    use knapsack
    implicit none
    integer, dimension(4) :: weights = [1, 3, 4, 5]
    integer, dimension(4) :: values = [1, 4, 5, 7]
    integer :: capacity = 7
    
    print *, "Knapsack max value: ", knapsack_01(weights, values, capacity)
end program test_knapsack

! Matrix Chain Multiplication
module matrix_chain
contains
    function matrix_chain_order(dims) result(cost)
        integer, dimension(:), intent(in) :: dims
        integer :: cost
        integer :: n, i, j, k, l, q
        integer, dimension(:,:), allocatable :: m
        
        n = size(dims) - 1
        allocate(m(n, n))
        m = 0
        
        do l = 2, n
            do i = 1, n - l + 1
                j = i + l - 1
                m(i, j) = 999999
                do k = i, j - 1
                    q = m(i, k) + m(k+1, j) + dims(i) * dims(k+1) * dims(j+1)
                    if (q < m(i, j)) then
                        m(i, j) = q
                    end if
                end do
            end do
        end do
        
        cost = m(1, n)
        deallocate(m)
    end function matrix_chain_order
end module matrix_chain

program test_matrix_chain
    use matrix_chain
    implicit none
    integer, dimension(5) :: dims = [10, 30, 5, 60, 10]
    
    print *, "Minimum multiplications: ", matrix_chain_order(dims)
end program test_matrix_chain

! Edit Distance
module edit_distance
contains
    function edit_distance(a, b) result(distance)
        character(len=*), intent(in) :: a, b
        integer :: distance
        integer :: m, n, i, j
        integer, dimension(:,:), allocatable :: dp
        
        m = len(a)
        n = len(b)
        allocate(dp(m+1, n+1))
        
        do i = 1, m+1
            dp(i, 1) = i - 1
        end do
        do j = 1, n+1
            dp(1, j) = j - 1
        end do
        
        do i = 2, m+1
            do j = 2, n+1
                if (a(i-1:i-1) == b(j-1:j-1)) then
                    dp(i, j) = dp(i-1, j-1)
                else
                    dp(i, j) = 1 + min(dp(i-1, j), dp(i, j-1), dp(i-1, j-1))
                end if
            end do
        end do
        
        distance = dp(m+1, n+1)
        deallocate(dp)
    end function edit_distance
end module edit_distance

program test_edit_distance
    use edit_distance
    implicit none
    character(len=20) :: a = "kitten"
    character(len=20) :: b = "sitting"
    
    print *, "Edit distance: ", edit_distance(a, b)
end program test_edit_distance

! Longest Palindromic Subsequence
module palindrome
contains
    function longest_palindrome_subseq(str) result(length)
        character(len=*), intent(in) :: str
        integer :: length
        integer :: n, i, j, l
        integer, dimension(:,:), allocatable :: dp
        
        n = len(str)
        allocate(dp(n, n))
        dp = 0
        
        do i = 1, n
            dp(i, i) = 1
        end do
        
        do l = 2, n
            do i = 1, n - l + 1
                j = i + l - 1
                if (str(i:i) == str(j:j)) then
                    dp(i, j) = dp(i+1, j-1) + 2
                else
                    dp(i, j) = max(dp(i+1, j), dp(i, j-1))
                end if
            end do
        end do
        
        length = dp(1, n)
        deallocate(dp)
    end function longest_palindrome_subseq
end module palindrome

program test_palindrome
    use palindrome
    implicit none
    character(len=20) :: str = "BBABCBCAB"
    
    print *, "Longest palindromic subsequence: ", longest_palindrome_subseq(str)
end program test_palindrome

! Coin Change Problem
module coin_change
contains
    function coin_change(coins, amount) result(min_coins)
        integer, dimension(:), intent(in) :: coins
        integer, intent(in) :: amount
        integer :: min_coins
        integer, dimension(:), allocatable :: dp
        integer :: i, j
        
        allocate(dp(amount + 1))
        dp = 999999
        dp(1) = 0
        
        do i = 1, amount
            do j = 1, size(coins)
                if (coins(j) <= i) then
                    dp(i+1) = min(dp(i+1), dp(i - coins(j) + 1) + 1)
                end if
            end do
        end do
        
        min_coins = dp(amount + 1)
        if (min_coins == 999999) min_coins = -1
        deallocate(dp)
    end function coin_change
end module coin_change

program test_coin_change
    use coin_change
    implicit none
    integer, dimension(4) :: coins = [1, 5, 6, 9]
    integer :: amount = 11
    
    print *, "Minimum coins: ", coin_change(coins, amount)
end program test_coin_change

! Subset Sum Problem
module subset_sum
contains
    function subset_sum_exists(arr, target) result(exists)
        integer, dimension(:), intent(in) :: arr
        integer, intent(in) :: target
        logical :: exists
        integer :: n, i, j
        logical, dimension(:,:), allocatable :: dp
        
        n = size(arr)
        allocate(dp(n+1, target+1))
        dp = .false.
        dp(1, 1) = .true.
        
        do i = 1, n
            do j = 0, target
                if (dp(i, j+1)) then
                    dp(i+1, j+1) = .true.
                end if
                if (j + arr(i) <= target) then
                    if (dp(i, j+1)) then
                        dp(i+1, j + arr(i) + 1) = .true.
                    end if
                end if
            end do
        end do
        
        exists = dp(n+1, target+1)
        deallocate(dp)
    end function subset_sum_exists
end module subset_sum

program test_subset_sum
    use subset_sum
    implicit none
    integer, dimension(6) :: arr = [3, 34, 4, 12, 5, 2]
    
    print *, "Subset sum 9: ", subset_sum_exists(arr, 9)
    print *, "Subset sum 30: ", subset_sum_exists(arr, 30)
end program test_subset_sum

! Segment Tree
module segment_tree
    implicit none
    type :: SegmentTree
        integer :: n
        integer, dimension(:), allocatable :: tree
    contains
        procedure :: init
        procedure :: build
        procedure :: update
        procedure :: query
    end type SegmentTree
    
contains
    subroutine init(self, n)
        class(SegmentTree), intent(inout) :: self
        integer, intent(in) :: n
        self%n = n
        allocate(self%tree(4 * n))
        self%tree = 0
    end subroutine init
    
    recursive subroutine build(self, node, l, r, arr)
        class(SegmentTree), intent(inout) :: self
        integer, intent(in) :: node, l, r
        integer, dimension(:), intent(in) :: arr
        integer :: mid
        
        if (l == r) then
            self%tree(node) = arr(l)
        else
            mid = (l + r) / 2
            call self%build(node*2, l, mid, arr)
            call self%build(node*2+1, mid+1, r, arr)
            self%tree(node) = self%tree(node*2) + self%tree(node*2+1)
        end if
    end subroutine build
    
    recursive subroutine update(self, node, l, r, idx, value)
        class(SegmentTree), intent(inout) :: self
        integer, intent(in) :: node, l, r, idx, value
        integer :: mid
        
        if (l == r) then
            self%tree(node) = value
        else
            mid = (l + r) / 2
            if (idx <= mid) then
                call self%update(node*2, l, mid, idx, value)
            else
                call self%update(node*2+1, mid+1, r, idx, value)
            end if
            self%tree(node) = self%tree(node*2) + self%tree(node*2+1)
        end if
    end subroutine update
    
    recursive function query(self, node, l, r, ql, qr) result(sum)
        class(SegmentTree), intent(in) :: self
        integer, intent(in) :: node, l, r, ql, qr
        integer :: sum
        integer :: mid
        
        if (ql <= l .and. r <= qr) then
            sum = self%tree(node)
        else if (qr < l .or. r < ql) then
            sum = 0
        else
            mid = (l + r) / 2
            sum = self%query(node*2, l, mid, ql, qr) + &
                  self%query(node*2+1, mid+1, r, ql, qr)
        end if
    end function query
end module segment_tree

program test_segment_tree
    use segment_tree
    implicit none
    type(SegmentTree) :: st
    integer, dimension(6) :: arr = [1, 3, 5, 7, 9, 11]
    
    call st%init(6)
    call st%build(1, 1, 6, arr)
    
    print *, "Sum [1,3]: ", st%query(1, 1, 6, 1, 3)
    
    call st%update(1, 1, 6, 2, 10)
    print *, "Sum [1,3] after update: ", st%query(1, 1, 6, 1, 3)
end program test_segment_tree

! Fenwick Tree (BIT)
module fenwick_tree
    implicit none
    type :: FenwickTree
        integer :: n
        integer, dimension(:), allocatable :: tree
    contains
        procedure :: init
        procedure :: add
        procedure :: sum
        procedure :: range_sum
    end type FenwickTree
    
contains
    subroutine init(self, n)
        class(FenwickTree), intent(inout) :: self
        integer, intent(in) :: n
        self%n = n
        allocate(self%tree(n))
        self%tree = 0
    end subroutine init
    
    subroutine add(self, idx, value)
        class(FenwickTree), intent(inout) :: self
        integer, intent(in) :: idx, value
        do while (idx <= self%n)
            self%tree(idx) = self%tree(idx) + value
            idx = idx + iand(idx, -idx)
        end do
    end subroutine add
    
    function sum(self, idx) result(s)
        class(FenwickTree), intent(in) :: self
        integer, intent(in) :: idx
        integer :: s
        integer :: i
        s = 0
        i = idx
        do while (i > 0)
            s = s + self%tree(i)
            i = i - iand(i, -i)
        end do
    end function sum
    
    function range_sum(self, l, r) result(s)
        class(FenwickTree), intent(in) :: self
        integer, intent(in) :: l, r
        integer :: s
        s = self%sum(r) - self%sum(l - 1)
    end function range_sum
end module fenwick_tree

program test_fenwick
    use fenwick_tree
    implicit none
    type(FenwickTree) :: ft
    integer, dimension(6) :: arr = [1, 3, 5, 7, 9, 11]
    integer :: i
    
    call ft%init(6)
    do i = 1, 6
        call ft%add(i, arr(i))
    end do
    
    print *, "Prefix sum [1,3]: ", ft%sum(3)
    print *, "Range sum [1,3]: ", ft%range_sum(1, 3)
    print *, "Total sum: ", ft%sum(6)
end program test_fenwick

! Disjoint Set Union (DSU)
module dsu
    implicit none
    type :: DSU
        integer :: n
        integer, dimension(:), allocatable :: parent, rank
    contains
        procedure :: init
        procedure :: find
        procedure :: union
        procedure :: connected
    end type DSU
    
contains
    subroutine init(self, n)
        class(DSU), intent(inout) :: self
        integer, intent(in) :: n
        integer :: i
        
        self%n = n
        allocate(self%parent(n), self%rank(n))
        do i = 1, n
            self%parent(i) = i
            self%rank(i) = 0
        end do
    end subroutine init
    
    recursive function find(self, x) result(root)
        class(DSU), intent(inout) :: self
        integer, intent(in) :: x
        integer :: root
        
        if (self%parent(x) /= x) then
            self%parent(x) = self%find(self%parent(x))
        end if
        root = self%parent(x)
    end function find
    
    subroutine union(self, x, y)
        class(DSU), intent(inout) :: self
        integer, intent(in) :: x, y
        integer :: x_root, y_root
        
        x_root = self%find(x)
        y_root = self%find(y)
        
        if (x_root /= y_root) then
            if (self%rank(x_root) < self%rank(y_root)) then
                self%parent(x_root) = y_root
            else if (self%rank(x_root) > self%rank(y_root)) then
                self%parent(y_root) = x_root
            else
                self%parent(y_root) = x_root
                self%rank(x_root) = self%rank(x_root) + 1
            end if
        end if
    end subroutine union
    
    function connected(self, x, y) result(conn)
        class(DSU), intent(inout) :: self
        integer, intent(in) :: x, y
        logical :: conn
        conn = self%find(x) == self%find(y)
    end function connected
end module dsu

program test_dsu
    use dsu
    implicit none
    type(DSU) :: dsu
    
    call dsu%init(6)
    call dsu%union(1, 2)
    call dsu%union(2, 3)
    call dsu%union(4, 5)
    
    print *, "1 and 2 connected: ", dsu%connected(1, 2)
    print *, "1 and 3 connected: ", dsu%connected(1, 3)
    print *, "1 and 4 connected: ", dsu%connected(1, 4)
    
    call dsu%union(3, 4)
    print *, "After union 3 and 4:"
    print *, "1 and 5 connected: ", dsu%connected(1, 5)
end program test_dsu

! Trie Data Structure
module trie
    implicit none
    integer, parameter :: ALPHABET_SIZE = 26
    
    type :: TrieNode
        logical :: is_end = .false.
        type(TrieNode), pointer :: children(ALPHABET_SIZE) => null()
    end type TrieNode
    
    type :: Trie
        type(TrieNode), pointer :: root => null()
    contains
        procedure :: init
        procedure :: insert
        procedure :: search
        procedure :: starts_with
    end type Trie
    
contains
    subroutine init(self)
        class(Trie), intent(inout) :: self
        allocate(self%root)
        self%root%is_end = .false.
    end subroutine init
    
    subroutine insert(self, word)
        class(Trie), intent(inout) :: self
        character(len=*), intent(in) :: word
        type(TrieNode), pointer :: current
        integer :: i, idx
        
        current => self%root
        do i = 1, len(word)
            idx = iachar(word(i:i)) - iachar('a') + 1
            if (.not. associated(current%children(idx))) then
                allocate(current%children(idx))
                current%children(idx)%is_end = .false.
            end if
            current => current%children(idx)
        end do
        current%is_end = .true.
    end subroutine insert
    
    function search(self, word) result(found)
        class(Trie), intent(in) :: self
        character(len=*), intent(in) :: word
        logical :: found
        type(TrieNode), pointer :: current
        integer :: i, idx
        
        current => self%root
        do i = 1, len(word)
            idx = iachar(word(i:i)) - iachar('a') + 1
            if (.not. associated(current%children(idx))) then
                found = .false.
                return
            end if
            current => current%children(idx)
        end do
        found = current%is_end
    end function search
    
    function starts_with(self, prefix) result(found)
        class(Trie), intent(in) :: self
        character(len=*), intent(in) :: prefix
        logical :: found
        type(TrieNode), pointer :: current
        integer :: i, idx
        
        current => self%root
        do i = 1, len(prefix)
            idx = iachar(prefix(i:i)) - iachar('a') + 1
            if (.not. associated(current%children(idx))) then
                found = .false.
                return
            end if
            current => current%children(idx)
        end do
        found = .true.
    end function starts_with
end module trie

program test_trie
    use trie
    implicit none
    type(Trie) :: trie
    
    call trie%init()
    call trie%insert("apple")
    call trie%insert("app")
    call trie%insert("apply")
    
    print *, "Search 'apple': ", trie%search("apple")
    print *, "Search 'app': ", trie%search("app")
    print *, "Search 'ap': ", trie%search("ap")
    print *, "Starts with 'appl': ", trie%starts_with("appl")
    print *, "Starts with 'xyz': ", trie%starts_with("xyz")
end program test_trie

! Suffix Array
module suffix_array
contains
    function build_suffix_array(str) result(sa)
        character(len=*), intent(in) :: str
        integer, dimension(:), allocatable :: sa
        integer :: n, i
        
        n = len(str)
        allocate(sa(n))
        do i = 1, n
            sa(i) = i
        end do
        
        ! Simple implementation - sort suffixes
        call sort_suffixes(str, sa, 1, n)
    end function build_suffix_array
    
    recursive subroutine sort_suffixes(str, sa, l, r)
        character(len=*), intent(in) :: str
        integer, dimension(:), intent(inout) :: sa
        integer, intent(in) :: l, r
        integer :: i, j, pivot
        
        if (l < r) then
            pivot = l
            i = l
            j = r
            
            do while (i < j)
                do while (compare_suffix(str, sa(i), sa(pivot)) <= 0 .and. i < r)
                    i = i + 1
                end do
                do while (compare_suffix(str, sa(j), sa(pivot)) > 0)
                    j = j - 1
                end do
                if (i < j) then
                    call swap(sa(i), sa(j))
                end if
            end do
            
            call swap(sa(pivot), sa(j))
            call sort_suffixes(str, sa, l, j - 1)
            call sort_suffixes(str, sa, j + 1, r)
        end if
    end subroutine sort_suffixes
    
    function compare_suffix(str, i, j) result(cmp)
        character(len=*), intent(in) :: str
        integer, intent(in) :: i, j
        integer :: cmp
        integer :: k, n
        
        n = len(str)
        k = 0
        do while (i + k <= n .and. j + k <= n .and. str(i+k:i+k) == str(j+k:j+k))
            k = k + 1
        end do
        
        if (i + k > n .and. j + k > n) then
            cmp = 0
        else if (i + k > n) then
            cmp = -1
        else if (j + k > n) then
            cmp = 1
        else if (str(i+k:i+k) < str(j+k:j+k)) then
            cmp = -1
        else
            cmp = 1
        end if
    end function compare_suffix
    
    subroutine swap(a, b)
        integer, intent(inout) :: a, b
        integer :: temp
        temp = a
        a = b
        b = temp
    end subroutine swap
end module suffix_array

program test_suffix_array
    use suffix_array
    implicit none
    integer, dimension(:), allocatable :: sa
    character(len=20) :: str = "banana"
    integer :: i
    
    sa = build_suffix_array(str)
    print *, "Suffix array for 'banana':"
    do i = 1, size(sa)
        print *, sa(i), " -> ", str(sa(i):)
    end do
end program test_suffix_array

! KMP Pattern Matching
module kmp
contains
    function kmp_search(text, pattern) result(pos)
        character(len=*), intent(in) :: text, pattern
        integer :: pos
        integer, dimension(:), allocatable :: lps
        integer :: i, j, n, m
        
        n = len(text)
        m = len(pattern)
        allocate(lps(m))
        lps = 0
        
        call compute_lps(pattern, lps)
        
        i = 1
        j = 1
        pos = -1
        
        do while (i <= n)
            if (text(i:i) == pattern(j:j)) then
                i = i + 1
                j = j + 1
                if (j > m) then
                    pos = i - m
                    return
                end if
            else
                if (j > 1) then
                    j = lps(j-1) + 1
                else
                    i = i + 1
                end if
            end if
        end do
        
        deallocate(lps)
    end function kmp_search
    
    subroutine compute_lps(pattern, lps)
        character(len=*), intent(in) :: pattern
        integer, dimension(:), intent(out) :: lps
        integer :: i, j, m
        
        m = len(pattern)
        i = 2
        j = 1
        lps(1) = 0
        
        do while (i <= m)
            if (pattern(i:i) == pattern(j:j)) then
                lps(i) = j
                i = i + 1
                j = j + 1
            else
                if (j > 1) then
                    j = lps(j-1) + 1
                else
                    lps(i) = 0
                    i = i + 1
                end if
            end if
        end do
    end subroutine compute_lps
end module kmp

program test_kmp
    use kmp
    implicit none
    character(len=30) :: text = "AABAACAADAABAABA"
    character(len=10) :: pattern = "AABA"
    integer :: pos
    
    pos = kmp_search(text, pattern)
    print *, "Pattern found at: ", pos
end program test_kmp

! Rabin-Karp String Matching
module rabin_karp
contains
    function rabin_karp(text, pattern) result(pos)
        character(len=*), intent(in) :: text, pattern
        integer :: pos
        integer :: n, m, i, hash_pat, hash_txt, h
        integer, parameter :: d = 256, q = 101
        
        n = len(text)
        m = len(pattern)
        pos = -1
        
        if (m > n) return
        
        hash_pat = 0
        hash_txt = 0
        h = 1
        
        do i = 1, m - 1
            h = mod(h * d, q)
        end do
        
        do i = 1, m
            hash_pat = mod(hash_pat * d + iachar(pattern(i:i)), q)
            hash_txt = mod(hash_txt * d + iachar(text(i:i)), q)
        end do
        
        do i = 1, n - m + 1
            if (hash_pat == hash_txt) then
                if (text(i:i+m-1) == pattern) then
                    pos = i
                    return
                end if
            end if
            
            if (i <= n - m) then
                hash_txt = mod(hash_txt - iachar(text(i:i)) * h, q)
                if (hash_txt < 0) hash_txt = hash_txt + q
                hash_txt = mod(hash_txt * d + iachar(text(i+m:i+m)), q)
            end if
        end do
    end function rabin_karp
end module rabin_karp

program test_rabin_karp
    use rabin_karp
    implicit none
    character(len=30) :: text = "AABAACAADAABAABA"
    character(len=10) :: pattern = "AABA"
    integer :: pos
    
    pos = rabin_karp(text, pattern)
    print *, "Pattern found at: ", pos
end program test_rabin_karp

! Boyer-Moore String Matching
module boyer_moore
contains
    function boyer_moore(text, pattern) result(pos)
        character(len=*), intent(in) :: text, pattern
        integer :: pos
        integer :: n, m, i, j, bad_char(256)
        
        n = len(text)
        m = len(pattern)
        pos = -1
        
        if (m > n) return
        
        ! Preprocess bad character
        do i = 1, 256
            bad_char(i) = m
        end do
        
        do i = 1, m - 1
            bad_char(iachar(pattern(i:i)) + 1) = m - i
        end do
        
        i = m
        do while (i <= n)
            j = m
            do while (j >= 1 .and. text(i - m + j:i - m + j) == pattern(j:j))
                j = j - 1
            end do
            
            if (j == 0) then
                pos = i - m + 1
                return
            end if
            
            i = i + bad_char(iachar(text(i:i)) + 1)
        end do
    end function boyer_moore
end module boyer_moore

program test_boyer_moore
    use boyer_moore
    implicit none
    character(len=30) :: text = "AABAACAADAABAABA"
    character(len=10) :: pattern = "AABA"
    integer :: pos
    
    pos = boyer_moore(text, pattern)
    print *, "Pattern found at: ", pos
end program test_boyer_moore

! N-Queens Problem
module n_queens
    implicit none
    integer, parameter :: MAX_SIZE = 20
    integer :: solutions = 0
    
contains
    recursive subroutine solve_n_queens(n, row, board)
        integer, intent(in) :: n
        integer, intent(in) :: row
        integer, dimension(n), intent(inout) :: board
        integer :: col, i
        logical :: safe
        
        if (row > n) then
            solutions = solutions + 1
            if (solutions == 1) then
                print *, "First solution:"
                do i = 1, n
                    print *, board(i)
                end do
            end if
            return
        end if
        
        do col = 1, n
            safe = .true.
            
            ! Check previous rows
            do i = 1, row - 1
                if (board(i) == col .or. &
                    board(i) - i == col - row .or. &
                    board(i) + i == col + row) then
                    safe = .false.
                    exit
                end if
            end do
            
            if (safe) then
                board(row) = col
                call solve_n_queens(n, row + 1, board)
            end if
        end do
    end subroutine solve_n_queens
end module n_queens

program test_n_queens
    use n_queens
    implicit none
    integer, dimension(8) :: board
    integer :: n = 8
    
    board = 0
    call solve_n_queens(n, 1, board)
    print *, "Total solutions: ", solutions
end program test_n_queens

! Sudoku Solver
module sudoku
    implicit none
    integer, dimension(9,9) :: board
    
contains
    function solve_sudoku() result(solved)
        logical :: solved
        integer :: row, col, num
        
        if (find_empty(row, col)) then
            do num = 1, 9
                if (is_valid(row, col, num)) then
                    board(row, col) = num
                    if (solve_sudoku()) then
                        solved = .true.
                        return
                    end if
                    board(row, col) = 0
                end if
            end do
            solved = .false.
        else
            solved = .true.
        end if
    end function solve_sudoku
    
    function find_empty(row, col) result(found)
        integer, intent(out) :: row, col
        logical :: found
        integer :: i, j
        
        do i = 1, 9
            do j = 1, 9
                if (board(i, j) == 0) then
                    row = i
                    col = j
                    found = .true.
                    return
                end if
            end do
        end do
        found = .false.
    end function find_empty
    
    function is_valid(row, col, num) result(valid)
        integer, intent(in) :: row, col, num
        logical :: valid
        integer :: i, j, start_row, start_col
        
        ! Check row
        do i = 1, 9
            if (board(row, i) == num) then
                valid = .false.
                return
            end if
        end do
        
        ! Check column
        do i = 1, 9
            if (board(i, col) == num) then
                valid = .false.
                return
            end if
        end do
        
        ! Check 3x3 box
        start_row = ((row - 1) / 3) * 3 + 1
        start_col = ((col - 1) / 3) * 3 + 1
        do i = start_row, start_row + 2
            do j = start_col, start_col + 2
                if (board(i, j) == num) then
                    valid = .false.
                    return
                end if
            end do
        end do
        
        valid = .true.
    end function is_valid
    
    subroutine print_board()
        integer :: i, j
        do i = 1, 9
            do j = 1, 9
                write(*, '(I2)', advance='no') board(i, j)
            end do
            print *
        end do
    end subroutine print_board
end module sudoku

program test_sudoku
    use sudoku
    implicit none
    
    board = reshape([ &
        5, 3, 0, 0, 7, 0, 0, 0, 0, &
        6, 0, 0, 1, 9, 5, 0, 0, 0, &
        0, 9, 8, 0, 0, 0, 0, 6, 0, &
        8, 0, 0, 0, 6, 0, 0, 0, 3, &
        4, 0, 0, 8, 0, 3, 0, 0, 1, &
        7, 0, 0, 0, 2, 0, 0, 0, 6, &
        0, 6, 0, 0, 0, 0, 2, 8, 0, &
        0, 0, 0, 4, 1, 9, 0, 0, 5, &
        0, 0, 0, 0, 8, 0, 0, 7, 9 &
    ], [9, 9])
    
    if (solve_sudoku()) then
        print *, "Solution:"
        call print_board()
    else
        print *, "No solution exists"
    end if
end program test_sudoku

! Eight Queens Problem
module eight_queens
    implicit none
    integer, parameter :: N = 8
    integer, dimension(N) :: queens
    integer :: solution_count = 0
    
contains
    subroutine solve_queens(row)
        integer, intent(in) :: row
        integer :: col, i
        logical :: safe
        
        if (row > N) then
            solution_count = solution_count + 1
            call print_solution()
            return
        end if
        
        do col = 1, N
            safe = .true.
            do i = 1, row - 1
                if (queens(i) == col .or. &
                    queens(i) - i == col - row .or. &
                    queens(i) + i == col + row) then
                    safe = .false.
                    exit
                end if
            end do
            
            if (safe) then
                queens(row) = col
                call solve_queens(row + 1)
            end if
        end do
    end subroutine solve_queens
    
    subroutine print_solution()
        integer :: i, j
        
        print *, "Solution ", solution_count, ":"
        do i = 1, N
            do j = 1, N
                if (queens(i) == j) then
                    write(*, '(A2)', advance='no') "Q "
                else
                    write(*, '(A2)', advance='no') ". "
                end if
            end do
            print *
        end do
        print *
    end subroutine print_solution
end module eight_queens

program test_eight_queens
    use eight_queens
    implicit none
    
    queens = 0
    call solve_queens(1)
    print *, "Total solutions: ", solution_count
end program test_eight_queens

! Tower of Hanoi
module hanoi
    implicit none
    integer :: moves = 0
    
contains
    recursive subroutine solve_hanoi(n, from, to, aux)
        integer, intent(in) :: n
        character(len=1), intent(in) :: from, to, aux
        
        if (n == 1) then
            moves = moves + 1
            print *, moves, ": Move disk 1 from ", from, " to ", to
        else
            call solve_hanoi(n - 1, from, aux, to)
            moves = moves + 1
            print *, moves, ": Move disk ", n, " from ", from, " to ", to
            call solve_hanoi(n - 1, aux, to, from)
        end if
    end subroutine solve_hanoi
end module hanoi

program test_hanoi
    use hanoi
    implicit none
    integer :: n = 3
    
    print *, "Tower of Hanoi with ", n, " disks:"
    call solve_hanoi(n, 'A', 'C', 'B')
    print *, "Total moves: ", moves
end program test_hanoi

! Permutations Generation
module permutations
    implicit none
    integer :: count = 0
    
contains
    recursive subroutine generate_permutations(arr, start, n)
        integer, dimension(:), intent(inout) :: arr
        integer, intent(in) :: start, n
        integer :: i
        
        if (start > n) then
            count = count + 1
            print *, count, ": ", arr
        else
            do i = start, n
                call swap(arr(start), arr(i))
                call generate_permutations(arr, start + 1, n)
                call swap(arr(start), arr(i))
            end do
        end if
    end subroutine generate_permutations
    
    subroutine swap(a, b)
        integer, intent(inout) :: a, b
        integer :: temp
        temp = a
        a = b
        b = temp
    end subroutine swap
end module permutations

program test_permutations
    use permutations
    implicit none
    integer, dimension(4) :: arr = [1, 2, 3, 4]
    
    print *, "Permutations of [1, 2, 3, 4]:"
    call generate_permutations(arr, 1, 4)
    print *, "Total permutations: ", count
end program test_permutations

! Combinations Generation
module combinations
    implicit none
    integer :: count = 0
    
contains
    recursive subroutine generate_combinations(arr, data, start, end, idx, r)
        integer, dimension(:), intent(in) :: arr
        integer, dimension(:), intent(inout) :: data
        integer, intent(in) :: start, end, idx, r
        integer :: i
        
        if (idx > r) then
            count = count + 1
            print *, count, ": ", data(1:r)
        else
            do i = start, end - r + idx
                data(idx) = arr(i)
                call generate_combinations(arr, data, i + 1, end, idx + 1, r)
            end do
        end if
    end subroutine generate_combinations
end module combinations

program test_combinations
    use combinations
    implicit none
    integer, dimension(5) :: arr = [1, 2, 3, 4, 5]
    integer, dimension(5) :: data
    integer :: r = 3
    
    print *, "Combinations of 5 choose 3:"
    call generate_combinations(arr, data, 1, 5, 1, r)
    print *, "Total combinations: ", count
end program test_combinations

! Complete Library Management System
module library_system
    implicit none
    type :: Book
        character(len=20) :: id
        character(len=50) :: title
        character(len=30) :: author
        character(len=20) :: genre
        integer :: year
        integer :: copies
        integer :: available
    end type Book
    
    type :: Member
        character(len=10) :: id
        character(len=30) :: name
        character(len(30)) :: email
        integer :: borrowed_count
        character(len=20), dimension(5) :: borrowed_books
    end type Member
    
    type :: Library
        integer :: book_count = 0
        integer :: member_count = 0
        type(Book), dimension(100) :: books
        type(Member), dimension(100) :: members
    contains
        procedure :: add_book
        procedure :: register_member
        procedure :: borrow_book
        procedure :: return_book
        procedure :: display_books
        procedure :: display_members
        procedure :: search_book
    end type Library
    
contains
    subroutine add_book(self, book)
        class(Library), intent(inout) :: self
        type(Book), intent(in) :: book
        self%book_count = self%book_count + 1
        self%books(self%book_count) = book
        print *, "Book added: ", trim(book%title)
    end subroutine add_book
    
    subroutine register_member(self, member)
        class(Library), intent(inout) :: self
        type(Member), intent(in) :: member
        self%member_count = self%member_count + 1
        self%members(self%member_count) = member
        print *, "Member registered: ", trim(member%name)
    end subroutine register_member
    
    subroutine borrow_book(self, member_id, book_id)
        class(Library), intent(inout) :: self
        character(len=*), intent(in) :: member_id, book_id
        integer :: i, j, book_idx, member_idx
        
        book_idx = 0
        do i = 1, self%book_count
            if (trim(self%books(i)%id) == trim(book_id)) then
                book_idx = i
                exit
            end if
        end do
        
        if (book_idx == 0) then
            print *, "Book not found: ", trim(book_id)
            return
        end if
        
        member_idx = 0
        do i = 1, self%member_count
            if (trim(self%members(i)%id) == trim(member_id)) then
                member_idx = i
                exit
            end if
        end do
        
        if (member_idx == 0) then
            print *, "Member not found: ", trim(member_id)
            return
        end if
        
        if (self%books(book_idx)%available <= 0) then
            print *, "Book not available: ", trim(self%books(book_idx)%title)
            return
        end if
        
        self%books(book_idx)%available = self%books(book_idx)%available - 1
        self%members(member_idx)%borrowed_count = self%members(member_idx)%borrowed_count + 1
        self%members(member_idx)%borrowed_books(self%members(member_idx)%borrowed_count) = book_id
        
        print *, trim(self%members(member_idx)%name), " borrowed: ", trim(self%books(book_idx)%title)
    end subroutine borrow_book
    
    subroutine return_book(self, member_id, book_id)
        class(Library), intent(inout) :: self
        character(len=*), intent(in) :: member_id, book_id
        integer :: i, j, book_idx, member_idx
        
        book_idx = 0
        do i = 1, self%book_count
            if (trim(self%books(i)%id) == trim(book_id)) then
                book_idx = i
                exit
            end if
        end do
        
        if (book_idx == 0) then
            print *, "Book not found: ", trim(book_id)
            return
        end if
        
        member_idx = 0
        do i = 1, self%member_count
            if (trim(self%members(i)%id) == trim(member_id)) then
                member_idx = i
                exit
            end if
        end do
        
        if (member_idx == 0) then
            print *, "Member not found: ", trim(member_id)
            return
        end if
        
        ! Find borrowed book
        do i = 1, self%members(member_idx)%borrowed_count
            if (trim(self%members(member_idx)%borrowed_books(i)) == trim(book_id)) then
                self%books(book_idx)%available = self%books(book_idx)%available + 1
                self%members(member_idx)%borrowed_books(i) = ""
                self%members(member_idx)%borrowed_count = self%members(member_idx)%borrowed_count - 1
                print *, trim(self%members(member_idx)%name), " returned: ", trim(self%books(book_idx)%title)
                return
            end if
        end do
        
        print *, trim(self%members(member_idx)%name), " did not borrow this book"
    end subroutine return_book
    
    subroutine display_books(self)
        class(Library), intent(in) :: self
        integer :: i
        
        print *, "=== Library Catalog ==="
        do i = 1, self%book_count
            print *, trim(self%books(i)%id), " ", trim(self%books(i)%title), &
                " ", trim(self%books(i)%author), " ", trim(self%books(i)%genre), &
                " ", self%books(i)%year, " [", self%books(i)%available, "/", &
                self%books(i)%copies, "]"
        end do
    end subroutine display_books
    
    subroutine display_members(self)
        class(Library), intent(in) :: self
        integer :: i
        
        print *, "=== Library Members ==="
        do i = 1, self%member_count
            print *, "[", trim(self%members(i)%id), "] ", &
                trim(self%members(i)%name), " | Borrowed: ", &
                self%members(i)%borrowed_count, "/5"
        end do
    end subroutine display_members
    
    subroutine search_book(self, title)
        class(Library), intent(in) :: self
        character(len=*), intent(in) :: title
        integer :: i
        
        print *, "Search results for: ", trim(title)
        do i = 1, self%book_count
            if (index(trim(self%books(i)%title), trim(title)) > 0) then
                print *, trim(self%books(i)%title), " by ", trim(self%books(i)%author)
            end if
        end do
    end subroutine search_book
end module library_system

program test_library
    use library_system
    implicit none
    type(Library) :: lib
    
    ! Add books
    lib%add_book(Book("978-0", "The Fortran Book", "John Doe", "Programming", 2020, 3, 3))
    lib%add_book(Book("978-1", "Design Patterns", "Gang of Four", "Programming", 2015, 2, 2))
    lib%add_book(Book("978-2", "Clean Code", "Robert Martin", "Programming", 2008, 4, 4))
    
    ! Register members
    lib%register_member(Member("M001", "Alice Johnson", "alice@email.com", 0, ""))
    lib%register_member(Member("M002", "Bob Smith", "bob@email.com", 0, ""))
    lib%register_member(Member("M003", "Carol White", "carol@email.com", 0, ""))
    
    lib%display_books()
    
    ! Borrow books
    call lib%borrow_book("M001", "978-0")
    call lib%borrow_book("M001", "978-2")
    call lib%borrow_book("M002", "978-1")
    call lib%borrow_book("M003", "978-0")
    
    ! Return book
    call lib%return_book("M001", "978-0")
    
    lib%display_members()
    call lib%search_book("Code")
end program test_library