Fortran Programming

// Calculate sum of array square roots in JavaScript
const values = [1.0, 4.0, 9.0, 16.0];
let total = 0.0;

for (let i = 0; i < values.length; i++) {
    total += Math.sqrt(values[i]);
}

console.log("Total Sum:", total);

program rosetta_comparison
    implicit none
    real, dimension(4) :: values = [1.0, 4.0, 9.0, 16.0]
    real :: total

    ! Fortran vectorization automatically computes array mathematical expressions
    total = sum(sqrt(values))

    print *, "Total Sum:", total
end program rosetta_comparison

# 1. Compile source file into an executable named 'simulation'
gfortran -O3 -Wall main.f90 -o simulation

# 2. Run the executable
./simulation

# High-performance optimization flags used in production supercomputing
gfortran -O3 -march=native -ffast-math -fopenmp main.f90 -o super_sim

program type_declarations
    implicit none

    ! Primary Primitive Data Types
    integer :: loop_counter = 1
    real :: temperature = 98.6
    double precision :: precise_pi = 3.1415926535897932384d0
    complex :: AC_impedance = (4.0, 3.0)  ! Represents 4 + 3i
    logical :: is_converged = .true.
    character(len=30) :: experiment_title = "Thermal Dissipation Simulation"

    ! Printing Output
    print *, "Experiment Title:", experiment_title
    print *, "Double Precision Pi:", precise_pi
    print *, "Complex Variable Value:", AC_impedance
    print *, "Boolean Flag:", is_converged

end program type_declarations

program control_structures
    implicit none
    integer :: i, step_count = 5
    real :: current_value = 0.0

    ! 1. Conditional IF - ELSE IF - ELSE Block
    if (step_count > 10) then
        print *, "High iteration run"
    else if (step_count == 5) then
        print *, "Standard 5-step verification run"
    else
        print *, "Minimal execution"
    end if

    ! 2. Count-Controlled DO Loop (start, end, step)
    print *, "--- Executing Finite Loop ---"
    do i = 1, 10, 2
        print *, "Loop Index i =", i
    end do

    ! 3. Conditional DO WHILE Loop
    print *, "--- Executing DO WHILE Loop ---"
    do while (current_value < 100.0)
        current_value = current_value + 25.5
        print *, "Accumulated Value:", current_value
    end do

end program control_structures

program array_vectorization
    implicit none
    
    ! Array Declarations
    real, dimension(5) :: vector_a = [1.0, 2.0, 3.0, 4.0, 5.0]
    real, dimension(5) :: vector_b = [10.0, 20.0, 30.0, 40.0, 50.0]
    real, dimension(5) :: result_vector
    real, dimension(3, 3) :: matrix_grid  ! 2D 3x3 Grid

    ! 1. Native Vector Arithmetic (No Loops Required!)
    result_vector = (vector_a * 2.0) + vector_b

    print *, "Vector A:", vector_a
    print *, "Vectorized Computation Result:", result_vector

    ! 2. Array Slicing (Sub-sections)
    print *, "Sub-slice (Elements 2 through 4):", vector_a(2:4)

    ! 3. Built-in Mathematical Array Reduction Functions
    print *, "Sum of all elements:", sum(vector_a)
    print *, "Max Element:", maxval(vector_b)
    print *, "Dot Product:", dot_product(vector_a, vector_b)

end program array_vectorization

program modular_design
    implicit none
    real :: radius = 5.0, area, perimeter

    ! Execute Function
    area = calculate_circle_area(radius)
    print *, "Circle Area:", area

    ! Execute Subroutine
    call compute_circle_stats(radius, area, perimeter)
    print *, "Subroutine Returned Area:", area
    print *, "Subroutine Returned Perimeter:", perimeter

contains

    ! --- FUNCTION DEFINITION ---
    pure function calculate_circle_area(r) result(a)
        real, intent(in) :: r
        real :: a
        real, parameter :: PI = 3.14159265
        a = PI * (r**2)
    end function calculate_circle_area

    ! --- SUBROUTINE DEFINITION ---
    subroutine compute_circle_stats(r, a, p)
        real, intent(in) :: r
        real, intent(out) :: a, p
        real, parameter :: PI = 3.14159265
        a = PI * (r**2)
        p = 2.0 * PI * r
    end subroutine compute_circle_stats

end program modular_design

program derived_types_demo
    implicit none

    ! Define a custom spatial Particle type
    type :: Particle
        character(len=20) :: name
        real :: mass
        real, dimension(3) :: position ! X, Y, Z coordinates
        real, dimension(3) :: velocity
    end type Particle

    ! Declare an instance of Particle
    type(Particle) :: electron

    ! Instantiate properties percentage (%) operator accesses fields
    electron%name = "Electron"
    electron%mass = 9.109e-31
    electron%position = [0.0, 0.0, 0.0]
    electron%velocity = [1000.0, -500.0, 250.0]

    print *, "Particle Name:", electron%name
    print *, "Velocity Vector Z:", electron%velocity(3)

end program derived_types_demo

program dynamic_allocation
    implicit none
    integer :: user_grid_size, status_flag
    real, allocatable, dimension(:) :: dynamic_mesh

    print *, "Enter requested size of 1D simulation grid:"
    user_grid_size = 1000000 ! Example: 1 million points

    ! Dynamically allocate 1,000,000 floats on heap
    allocate(dynamic_mesh(user_grid_size), stat=status_flag)

    if (status_flag /= 0) then
        print *, "Memory allocation failed!"
        stop
    end if

    ! Initialize allocated array across entire grid
    dynamic_mesh = 0.0
    dynamic_mesh(1) = 100.0 ! Boundary condition

    print *, "Successfully allocated memory array of size:", size(dynamic_mesh)

    ! Clean up heap memory manually
    deallocate(dynamic_mesh)

end program dynamic_allocation

program export_csv
    implicit none
    integer :: i, file_unit = 20
    real :: time, velocity
    real, parameter :: g = 9.81

    ! Open file 'falling_object.csv' linked to logical unit number 20
    open(unit=file_unit, file="falling_object.csv", status="replace", action="write")

    ! Write CSV Header row
    write(file_unit, *) "Time(s), Velocity(m/s)"

    ! Loop through simulation steps and log formatted lines
    do i = 0, 100
        time = real(i) * 0.1
        velocity = g * time
        ! Formatted write string output
        write(file_unit, "(F8.2, ',', F8.2)") time, velocity
    end do

    ! Close connection safely
    close(file_unit)
    print *, "Data exported to falling_object.csv successfully."

end program export_csv

program heat_2d_simulation
    implicit none
    
    ! Grid dimensions
    integer, parameter :: NX = 50, NY = 50
    integer, parameter :: max_steps = 500
    real, dimension(NX, NY) :: T, T_new
    real :: alpha = 0.01, dt = 0.1, dx = 1.0, dy = 1.0
    real :: rx, ry
    integer :: i, j, step

    ! Calculate Diffusion Coefficients
    rx = alpha * dt / (dx**2)
    ry = alpha * dt / (dy**2)

    ! 1. Initialize temperature matrix to 20 degrees ambient
    T = 20.0

    ! 2. Set Dirichlet boundary conditions (Hot source on top edge = 100 deg)
    T(:, 1) = 100.0 

    ! Copy boundaries
    T_new = T

    ! 3. Time Stepping Loop
    do step = 1, max_steps
        do j = 2, NY - 1
            do i = 2, NX - 1
                ! Finite difference explicit scheme stencil
                T_new(i, j) = T(i, j) + &
                    rx * (T(i+1, j) - 2.0*T(i, j) + T(i-1, j)) + &
                    ry * (T(i, j+1) - 2.0*T(i, j) + T(i, j-1))
            end do
        end do
        
        ! Matrix update
        T = T_new
    end do

    print *, "Heat Diffusion Simulation Complete!"
    print *, "Center Core Temperature:", T(NX/2, NY/2)

end program heat_2d_simulation

program parallel_processing
    ! Requires compiling with gfortran -fopenmp openmp_demo.f90
    use omp_lib
    implicit none
    
    integer, parameter :: N = 10000000
    real, dimension(:), allocatable :: data_vector
    integer :: i

    allocate(data_vector(N))

    print *, "Running parallel computation across threads:", omp_get_max_threads()

    ! OpenMP Compiler Directive splitting loops automatically among CPU Cores
    !$omp parallel do
    do i = 1, N
        data_vector(i) = sin(real(i)) * cos(real(i))
    end do
    !$omp end parallel do

    print *, "Parallel Loop Completed Successfully."

    deallocate(data_vector)

end program parallel_processing