> FORTRAN REFERENCE MANUAL

C Colonne: 123456789...
C Col 1: C o * = commento
C Col 6: carattere = continuazione
C Col 1-5: etichetta numerica
C Col 7-72: codice
C Col 73+: ignorati (schede perforat.)
      PROGRAM HELLO
      WRITE(*,*) 'HELLO WORLD'
      END

! Commento con punto esclamativo
! Nessun vincolo di colonna
! Continuazione con & alla fine
program hello
  implicit none
  print *, "Hello World"  ! inline
  print *, "Testo lungo " &
         // "continua"
end program hello

program nome_programma
  implicit none  ! SEMPRE usare!

  ! dichiarazioni variabili

  ! istruzioni eseguibili
  print *, "Hello, Fortran!"

end program nome_programma

! Commento formato libero (F90+)
x = 5   ! Commento inline

C Commento formato fisso (F77)
* Anche con asterisco (F77)

character*20 :: name

! Stampa prompt
print *, "Inserisci nome: "

! Legge fino a spazio o newline
read *, name
print *, "Ciao ", name

! Lettura di 2 valori separati da spazio
character(len=20) :: f_name, l_name
read *, f_name, l_name
print *, "Ciao ", trim(f_name), " ", trim(l_name)

integer :: n
real :: x

! * = formato libero, * = stdin
read(*,*) n
read(*,*) x

! Formato specifico da stdin
read(*,'(i5)') n
read(*,'(f10.4)') x

! Gestione errori I/O
read(*,*, iostat=ierr, iomsg=msg) n
if (ierr /= 0) then
  print *, "Errore: ", trim(msg)
end if

! Lettura da stringa (internal read)
character(len=10) :: buf = "  42"
read(buf, *) n   ! n = 42

! Numeri interi
integer :: i = 0
integer(kind=2) :: i16 = 0   ! 16 bit
integer(kind=4) :: i32 = 0   ! 32 bit (default)
integer(kind=8) :: i64 = 0   ! 64 bit

! Numeri reali (float)
real :: r = 3.14            ! 32 bit ~6-7 cifre
real(kind=8) :: d = 3.14d0  ! 64 bit ~15 cifre
double precision :: dp = 1.1d0 ! =real(kind=8)

! Numeri complessi
complex :: c = (2.0, 4.0)   ! 2+4i
complex(kind=8) :: dc       ! doppia prec.

! Logici (boolean)
logical :: flag = .true.
logical :: ok   = .false.

! Caratteri e stringhe
character :: ch = 'A'
character(len=20) :: nome = "Mario"
character*20 :: nome2       ! sintassi F77

! PARAMETER = costante (non modificabile)
real, parameter :: PI = 3.14159265358979
integer, parameter :: MAX_N = 100

! Dichiarazione multipla
integer :: a = 1, b = 2, c

! SAVE: mantiene valore tra chiamate
integer, save :: counter = 0

! VOLATILE (F2003+)
real, volatile :: hw_register

! Limiti dei tipi
print *, "Max int:", huge(i)
print *, "Min real:", tiny(r)
print *, "Epsilon:", epsilon(r)
print *, "Kind int:", kind(i)
print *, "Kind real:", kind(r)

! Senza implicit none: I-N → INTEGER
!                       A-H,O-Z → REAL
implicit none     ! DISABILITA tutto ciò

! F77 style: definire tipi specifici
IMPLICIT REAL (A-F,X-Z)
IMPLICIT INTEGER (G-N)

! → INTEGER
int(3.9)         ! troncamento → 3
nint(3.5)        ! arrotondamento → 4
floor(3.9)       ! → 3
ceiling(3.1)     ! → 4

! → REAL / DBLE
real(5)          ! int → real
dble(5)          ! int → double
real(3.14, 8)    ! → kind=8

! → CHARACTER
char(65)         ! ASCII → 'A'
achar(65)        ! ASCII (portable)
iachar('A')      ! 'A' → 65

use iso_fortran_env   ! modulo standard

! Interi garantiti
integer, parameter :: i8  = INT8
integer, parameter :: i16 = INT16
integer, parameter :: i32 = INT32
integer, parameter :: i64 = INT64

! Reali garantiti
integer, parameter :: r32 = REAL32
integer, parameter :: r64 = REAL64
integer, parameter :: r128 = REAL128

real(r64) :: x = 1.0_r64
integer(i32) :: n = 0_i32

! Seleziona KIND per range
! selected_int_kind(r): range 10^r
integer, parameter :: &
  ik = selected_int_kind(9)   ! ±10^9

! selected_real_kind(p,r): p cifre, range 10^r
integer, parameter :: &
  rk = selected_real_kind(15, 300) ! doppia

real(rk) :: pi = 3.14159265358979_rk

! Suffisso letterale con KIND
real(r64) :: a = 1.234567890123456_r64
integer(i64) :: big = 9876543210_i64

! print *, formato/libero su stdout
print *, "Valore: ", 42
print *, 3.14

! write(unità, formato)
write(*,*) "Stdout, libero"
write(*,'(a,i5)') "N = ", 42
write(10,*) dato   ! unità 10 = file

! Interi: RiW (R ripetizioni, W larghezza)
print "(3i5)", 7, 6, 8   ! "    7    6    8"
print "(i5)", 7, 6, 8    ! 3 righe da i5

! Float: RfW.D
print "(2f8.3)", 3.1415, 1.234

! Esponenziale: ReW.D
print "(e12.4)", 123.456
!   0.1235E+03

! Stringa + intero
print "(a5,i3)", "Età: ", 43

! Nuova riga con /
print "(/, 2a10)", "Nome", "Età"

! WRITE interno (int → stringa)
character(len=10) :: buf
write(buf, "(i10)") 12345
print *, adjustl(buf)  ! allinea sx

! Giustificazione
print *, adjustl("  testo  ") ! sx
print *, adjustr("  testo  ") ! dx

! Formato doppia precisione: Dw.d
print "(d20.12)", 3.14159265358979d0

! Notazione BN/BZ per blanks
print "(bn,i5)", 42  ! blank = niente
print "(bz,i5)", 42  ! blank = zero

! Divisione intera (attenzione!)
5 / 4      ! = 1  (troncamento)
5 / 4.0    ! = 1.25 (almeno 1 real)
5.0 / 4    ! = 1.25
real(5)/4  ! = 1.25 (conversione)

! Precisione singola (6-7 cifre)
real :: a = 1.111111111
print "(f17.15)", a + a  ! troncato

! Doppia precisione (15 cifre)
double precision :: d = 1.111111111d0
print "(f18.16)", d + d

! Priorità: ** > * / > + -
! ** è RIGHT-associativo: 2**3**2 = 2**9

! random_number → [0.0, 1.0)
real :: r(1)
integer :: low=1, high=10, result

call random_number(r)
result = low + floor((high+1-low) * r(1))
print *, result   ! intero [1,10]

! Array di random
real :: arr(100)
call random_number(arr)

! Seed per riproducibilità
integer :: seed_size
integer, allocatable :: seed(:)

call random_seed(size=seed_size)
allocate(seed(seed_size))
seed = 42   ! valore fisso
call random_seed(put=seed)
call random_number(r)

print *, .true. .or. .false.    ! T
print *, .not. .true.           ! F
print *, 5 /= 9                 ! T
print *, "a" < "b"              ! T

integer :: age = 16

if ((age >= 5) .and. (age <= 6)) then
  print *, "Asilo"
else if ((age >= 7) .and. (age <= 13)) then
  print *, "Scuola Media"
else if ((age >= 14) .and. (age <= 18)) then
  print *, "Liceo"
else
  print *, "Adulto"
end if

! IF su una riga (logical IF)
if (x > 0) print *, "positivo"
if (n == 0) stop "Divisione per zero"

! IF con etichetta (named construct, F90+)
outer: if (a > 0) then
  inner: if (b > 0) then
    print *, "entrambi positivi"
  end if inner
end if outer

! IF aritmetico F77 (deprecato!)
! IF(expr) neg_label, zero_label, pos_label
IF(X-5) 10, 20, 30
10 CONTINUE  ! X < 5
20 CONTINUE  ! X = 5
30 CONTINUE  ! X > 5

integer :: age = 16

select case (age)
case (5)
  print *, "Asilo"
case (6:13)             ! range
  print *, "Scuola Media"
case (14,15,16,17,18)   ! lista
  print *, "Liceo"
case (:4)               ! fino a 4
  print *, "Neonato"
case default
  print *, "Adulto"
end select

character(len=3) :: day = "Mon"

select case (day)
case ("Mon", "Tue", "Wed", "Thu", "Fri")
  print *, "Giorno lavorativo"
case ("Sat", "Sun")
  print *, "Weekend"
end select

! Select con TYPE RANK (F2018+)
select rank (arr)
rank(0) ! scalare
rank(1) ! vettore
rank(2) ! matrice
rank default
end select

integer :: n

! DO start, end, step
do n = 1, 10
  print *, n
end do

! Con passo (step)
do n = 1, 10, 2     ! 1,3,5,7,9
  print "(i2)", n
end do

! Conteggio all'indietro
do n = 10, 1, -1
  print *, n
end do

! DO annidati
do n = 1, 5
  do m = 1, 5
    print *, n, m
  end do
end do

! F77: DO con etichetta
      DO 100 I = 1, 10
        WRITE(*,*) I
100   CONTINUE

! DO infinito (F90+)
do
  print *, "Infinito"
  exit   ! uscita
end do

! DO con etichetta (F90+)
outer: do n = 1, 5
  inner: do m = 1, 5
    if (m == 3) exit outer
    if (m == 2) cycle inner
    print *, n, m
  end do inner
end do outer

integer :: m = 1

! Cicla finché condizione è vera
do while (m < 20)
  if (mod(m,2) == 0) then
    print *, m
    m = m + 1
    cycle   ! torna all'inizio
  end if
  m = m + 1
  if (m >= 10) exit   ! esce
end do

! CYCLE = continua iterazione
! EXIT  = esce dal ciclo

! Indica iterazioni indipendenti
! (può essere parallelizzato)
real :: a(100), b(100)

do concurrent (i = 1:100)
  a(i) = sqrt(real(i))
end do

! Con maschera
do concurrent (i=1:100, a(i) > 0)
  b(i) = log(a(i))
end do

! Multi-indice
do concurrent (i=1:10, j=1:10)
  mat(i,j) = i * j
end do

! 1D: dimension(start:end)
integer, dimension(5)    :: a1   ! 1..5
integer, dimension(1:5)  :: a2   ! uguale
integer, dimension(0:4)  :: a3   ! 0..4
integer, dimension(-2:2) :: a4   ! -2..2

! 2D (matrice) e oltre
integer, dimension(5,5)    :: mat
real,    dimension(3,3,3)  :: cube3d

! Inizializzazione inline
integer :: v(5) = [1,2,3,4,5]      ! F2003
integer :: w(5) = (/ 1,2,3,4,5 /) ! F90

! Allocatable (dimensione a runtime)
integer, dimension(:), allocatable :: dyn1d
real, dimension(:,:), allocatable :: dyn2d

! Indice base 1 (default)
a1(1) = 5
print *, a1(1)

! Range (slice)
print *, a1(1:3)       ! elem 1,2,3
print *, a1(1:5:2)     ! 1,3,5 (passo 2)
print *, a1(:)         ! tutto
print *, a1(2:)        ! dal 2 in poi
print *, a1(:4)        ! fino al 4

! Matrice
mat(1,2) = 10
print *, mat(1,:)      ! riga 1
print *, mat(:,2)      ! colonna 2
print *, mat(1:3,1:3)  ! sotto-matrice

! Operazioni elemento per elemento
integer :: a(5)=[1,2,3,4,5], b(5)=[10,20,30,40,50]

a = a * 2              ! [2,4,6,8,10]
print *, a + b         ! [12,24,36,48,60]
print *, a ** 2        ! quadrato ogni elem

! Funzioni di riduzione
print *, sum(a)        ! somma tutti
print *, product(a)   ! prodotto
print *, maxval(a)     ! valore max
print *, minval(a)     ! valore min
print *, maxloc(a)     ! indice del max
print *, minloc(a)     ! indice del min

! Interrogazioni struttura
print *, size(a)        ! n. elementi tot
print *, size(mat,1)    ! dim 1 di mat
print *, size(mat,2)    ! dim 2 di mat
print *, rank(mat)      ! n. dimensioni = 2
print *, shape(mat)     ! [5,5]
print *, lbound(mat,1)  ! limite inferiore
print *, ubound(mat,1)  ! limite superiore

! Maschere
print *, all(a > 0)    ! tutti > 0?
print *, any(a > 3)    ! qualcuno > 3?
print *, count(a > 3)  ! quanti > 3?
print *, sum(a, a>3)   ! somma quelli >3

! RESHAPE: riformatta un array
integer :: v(9) = [1,2,3,4,5,6,7,8,9]
integer :: mat3(3,3)
mat3 = reshape(v, [3,3])
! Fortran è COLUMN-MAJOR:
! mat3(:,1)=[1,2,3], mat3(:,2)=[4,5,6]

! SPREAD: espande un array
integer :: row(3) = [1,2,3]
integer :: mat2(3,4)
mat2 = spread(row, 2, 4)  ! 4 copie lungo dim 2

! TRANSPOSE: trasposta matrice
real :: A(3,4), B(4,3)
B = transpose(A)

! ALLOCATE / DEALLOCATE
integer, allocatable :: arr(:)
integer :: n = 10

allocate(arr(n))
arr = [(i, i=1,n)]   ! implied do
print *, arr
deallocate(arr)

! Verifica allocazione
if (allocated(arr)) deallocate(arr)

! MOVE_ALLOC (F2003+): sposta senza copia
call move_alloc(arr, arr2)

! Implied DO per inizializzazione
integer :: sq(10) = [(i*i, i=1,10)]

! Implied DO per stampa
print "(5i4)", (sq(i), i=1,5)

! Nested implied DO
integer :: m(3,3) = &
  reshape([(i, i=1,9)],[3,3])

! WHERE: operazione condizionale
real :: a(100), b(100)

where (a > 0)
  b = sqrt(a)
elsewhere
  b = 0.0
end where

! WHERE su una riga
where (a < 0) a = 0.0

! FORMAT con numero di riga (F77 style)
      WRITE(*,100) X, Y
100   FORMAT('X=',F8.3,' Y=',F8.3)

! FORMAT in variabile stringa (F90+)
character(len=20) :: fmt
fmt = "(i5,f10.3)"
write(*, fmt) 42, 3.14

! Formato come parametro
integer, parameter :: W = 8
write(*,"(i," // achar(48+W) // ")") n

! T: tabulazione assoluta a colonna n
print "(a,t20,a)", "Nome", "Età"

! TL/TR: tabulazione relativa (sinistra/destra)
print "(a,tr5,a)", "A", "B"  ! 5 sp dx

! SS/SP: segno in output float
print "(sp,f8.2)", 3.14   ! +3.14
print "(ss,f8.2)", 3.14   ! 3.14

! Ripetizioni di gruppo
print "(3(a5,i3))", s1,n1,s2,n2,s3,n3

! P: fattore di scala
print "(1p,f10.4)", 0.001 ! 0.0010 x10

character(len=20) :: s1 = "Hello"
character(len=20) :: s2 = "World"
character(len=40) :: s3

! Concatenazione con //
s3 = trim(s1) // " " // trim(s2)
print *, s3    ! "Hello World"

! Substring (slicing)
print *, s1(1:3)    ! "Hel"
print *, s1(2:4)    ! "ell"

! Assegnazione substring
s1(1:3) = "Bye"

! Lunghezza effettiva vs dichiarata
print *, len(s1)          ! 20 (dichiarata)
print *, len_trim(s1)     ! senza trailing spaces

! Confronto (lessicografico)
print *, "abc" < "abd"    ! .TRUE.
print *, llt("a", "b")   ! portable lt
print *, lgt("b", "a")   ! portable gt
print *, lle("a", "a")   ! portable le
print *, lge("b", "a")   ! portable ge

! Stringa allocatable (F2003+)
character(len=:), allocatable :: s

allocate(character(len=50) :: s)
s = "Lunghezza automatica"

! Assegnazione automatica
s = "ciao"   ! len diventa 4
s = s // " mondo"  ! automatico
print *, len(s)   ! 10

! Definizione tipo
type Customer
  character(len=40) :: name
  integer           :: age
  real              :: balance
end type Customer

! Dichiarazione variabili
type(Customer) :: c1
type(Customer), dimension(5) :: clients

! Assegnazione campi (% operatore)
c1%name    = "Mario Rossi"
c1%age     = 34
c1%balance = 1250.75

! Constructor
c1 = Customer("Luigi", 25, 500.0)

! Array di strutture
clients(1) = c1
clients(2)%name = "Anna"

! Tipo annidato
type Address
  character(len=50) :: street
  character(len=20) :: city
end type Address

type Person
  character(len=30) :: name
  type(Address)      :: addr
end type Person

type(Person) :: p
p%name       = "Giulia"
p%addr%city  = "Roma"

! Valori default (F2003+)
type Point
  real :: x = 0.0
  real :: y = 0.0
end type Point

! Array in struttura
type Vector3
  real :: v(3) = [0.0, 0.0, 0.0]
end type Vector3

contains

  ! Stile 1: tipo nel nome funzione
  integer function get_sum(n1, n2)
    implicit none
    integer :: n1, n2
    get_sum = n1 + n2   ! ritorna il valore
  end function get_sum

  ! Stile 2: result clause
  function get_sum2(n1, n2) result(res)
    implicit none
    integer, intent(in) :: n1, n2
    integer :: res
    res = n1 + n2
  end function get_sum2

  ! Stile 3: PURE (nessun side-effect)
  pure function square(x) result(res)
    real, intent(in) :: x
    real :: res
    res = x * x
  end function square

! intent(in)  = solo input (read-only)
! intent(out) = solo output
! intent(inout) = input e output

function norm(v) result(r)
  real, intent(in) :: v(:)
  real :: r
  r = sqrt(sum(v**2))
end function

! ELEMENTAL (F95+): opera su array
elemental function clamp(x, lo, hi) result(r)
  real, intent(in) :: x, lo, hi
  real :: r
  r = max(lo, min(x, hi))
end function

! Funzione con array result
function linspace(a, b, n) result(v)
  real, intent(in) :: a, b
  integer, intent(in) :: n
  real :: v(n)
  integer :: i
  v = [(a + (b-a)*(i-1)/(n-1), i=1,n)]
end function

function get_sum3(n1, n2) result(res)
  implicit none
  integer, intent(in) :: n1
  integer, intent(in), optional :: n2
  integer :: res

  if (present(n2)) then
    res = n1 + n2
  else
    res = n1 + 1   ! default
  end if
end function

! Chiamate
print *, get_sum3(5)       ! = 6
print *, get_sum3(5, 4)    ! = 9
print *, get_sum3(n1=5, n2=4) ! keyword

subroutine plot(x, y, color, width)
  real, intent(in) :: x, y
  character(*), intent(in), optional :: color
  real, intent(in), optional :: width
  ! ...
end subroutine

! Chiamata con keyword (ordine libero)
call plot(1.0, 2.0)
call plot(1.0, 2.0, color="red")
call plot(y=2.0, x=1.0, width=2.5)

! PRESENT() per verificare presenza
if (present(color)) then
  print *, "Colore: ", color
end if

! Obbligatorio "recursive" in F90-F2017
! Opzionale in F2018+
recursive function factorial(n) result(r)
  integer, intent(in) :: n
  integer :: r
  if (n <= 1) then
    r = 1
  else
    r = n * factorial(n - 1)
  end if
end function factorial

! Uso:
print *, factorial(10)  ! 3628800

! Fibonacci
recursive function fib(n) result(r)
  integer, intent(in) :: n
  integer :: r
  if (n <= 1) then
    r = n
  else
    r = fib(n-1) + fib(n-2)
  end if
end function

! Potenza intera (ricorsiva)
recursive function ipow(base, exp) result(r)
  integer, intent(in) :: base, exp
  integer :: r
  if (exp == 0) then
    r = 1
  else
    r = base * ipow(base, exp - 1)
  end if
end function

! Subroutine: ritorna più valori
subroutine plus_two(n, p1, p2)
  integer, intent(in)  :: n
  integer, intent(out) :: p1, p2
  p1 = n + 1
  p2 = n + 2
end subroutine plus_two

! Chiamata con CALL
integer :: i=1, a, b
call plus_two(i, a, b)
print *, i, a, b  ! 1 2 3

! INTENT(INOUT): modifica in-place
subroutine swap(a, b)
  real, intent(inout) :: a, b
  real :: tmp
  tmp = a; a = b; b = tmp
end subroutine

! Subroutine con array assunto-forma
subroutine fill_sq(arr, n)
  integer, intent(out) :: arr(:)
  integer, intent(in)  :: n
  integer :: i
  do i = 1, min(n, size(arr))
    arr(i) = i * i
  end do
end subroutine

! Subroutine come argomento (external)
subroutine apply(sub, x)
  external :: sub
  real, intent(inout) :: x
  call sub(x)
end subroutine

! STOP e ERROR STOP
if (n < 0) stop "Errore: n negativo"
if (n < 0) error stop   ! F2008+

! File: math_utils.f90
module math_utils
  implicit none
  private              ! tutto privato di default
  public :: PI, square  ! esportati

  real, parameter :: PI = 3.14159265358979

contains
  pure function square(x) result(r)
    real, intent(in) :: x
    real :: r
    r = x * x
  end function
end module math_utils

! Uso nel programma principale
use math_utils
use math_utils, only: PI   ! selettivo
use math_utils, pi2 => PI  ! rinomina

! File: mult_mod.f90
module mult_mod
  implicit none
  private
  public :: mult

  ! Associa più procedure a un nome
  interface mult
    procedure mult_real
    procedure mult_int
  end interface mult

contains
  real function mult_real(n1, n2)
    real, intent(in) :: n1, n2
    mult_real = n1 * n2
  end function

  integer function mult_int(n1, n2)
    integer, intent(in) :: n1, n2
    mult_int = n1 * n2
  end function
end module mult_mod

! Uso: il tipo determina la funzione
print *, mult(5, 4)        ! int: 20
print *, mult(5.3, 4.4)    ! real: 23.32

module vector_mod
  implicit none

  type Vec2
    real :: x, y
  end type

  interface operator(+)
    procedure vec_add
  end interface

  interface operator(*)
    procedure vec_scale
  end interface

contains
  function vec_add(a, b) result(c)
    type(Vec2), intent(in) :: a, b
    type(Vec2) :: c
    c = Vec2(a%x+b%x, a%y+b%y)
  end function

  function vec_scale(s, v) result(r)
    real, intent(in) :: s
    type(Vec2), intent(in) :: v
    type(Vec2) :: r
    r = Vec2(s*v%x, s*v%y)
  end function
end module

! Overloading di assegnazione
interface assignment(=)
  procedure int_to_vec
end interface

! Operatori definiti dall'utente
interface operator(.dot.)
  procedure dot_product_v
end interface

! Uso
use vector_mod
type(Vec2) :: u = Vec2(1.,2.)
type(Vec2) :: v = Vec2(3.,4.)
type(Vec2) :: w

w = u + v        ! vec_add
w = 2.0 * u      ! vec_scale

! Compilazione multi-modulo:
gfortran -c math_utils.f90
gfortran -c main.f90
gfortran math_utils.o main.o -o prog

! Dichiara puntatore
integer, pointer :: ptr1, ptr2

! Puntatore ad array
integer, pointer, dimension(:) :: arr_ptr

! Target (variabile puntata)
integer, target :: tgt = 0

! Allocare memoria per puntatore
allocate(ptr1)
ptr1 = 5
print *, ptr1

! Associare a target (=>)
ptr2 => tgt
ptr2 = 42
print *, tgt   ! 42 (stessa memoria)

! Disassocia
nullify(ptr2)

! Libera memoria
deallocate(ptr1)

! Controllo stato puntatore
if (associated(ptr1)) ...      ! è associato?
if (associated(ptr1, tgt)) ... ! punta a tgt?

! Puntatore array
real, target :: a(100)
real, pointer :: p(:)

p => a            ! punta a tutto a
p => a(10:50)     ! punta a una fetta
p => a(1:100:2)   ! ogni 2 elementi

! Lista collegata (esempio)
type Node
  integer :: val
  type(Node), pointer :: next => null()
end type

type(Node), pointer :: head => null()
allocate(head)
head%val = 1
allocate(head%next)
head%next%val = 2

integer :: unit_num = 10, ierr
character(256) :: errmsg

! OPEN: status = new/old/replace/scratch/unknown
open(unit=10, file='dati.dat',   &
     status='new',                 &
     action='write',               &
     iostat=ierr, iomsg=errmsg)

if (ierr /= 0) then
  write(*,*) "Errore: ", trim(errmsg)
  stop
end if

! WRITE su file
write(10,*) 3.14, 42, "test"
write(10, '(f8.3,i5)') 3.14, 42

! CLOSE
close(10)
close(10, status='DELETE')  ! e cancella

! Apertura in lettura
open(11, file='dati.dat', status='old', &
     action='read')

! Lettura con controllo EOF
real :: val
integer :: ios
do
  read(11, *, iostat=ios) val
  if (ios < 0) exit   ! EOF
  if (ios > 0) stop "Errore"
  print *, val
end do
close(11)

! STREAM I/O binario (F2003+)
open(20, file='bin.dat', access='stream', &
     form='unformatted')
write(20) 3.14, 42
close(20)

! INQUIRE: interroga file/unit
logical :: lexist
integer :: iunit
character(100) :: fname

! Esiste il file?
inquire(file='dati.dat', exist=lexist)

! Info su unit aperta
inquire(unit=10, name=fname)

! BACKSPACE, REWIND, ENDFILE
rewind(10)       ! torna all'inizio
backspace(10)    ! un record indietro
endfile(10)      ! segna fine file

! File: shape_mod.f90
module shape_mod
  implicit none

  ! Tipo astratto (non instanziabile)
  type, abstract :: shape_t
    real :: x = 0.0, y = 0.0
  contains
    procedure(area_interface), deferred :: area
    procedure :: describe
  end type

  ! Interfaccia per metodo deferred
  abstract interface
    function area_interface(this) result(a)
      import :: shape_t
      class(shape_t), intent(in) :: this
      real :: a
    end function
  end interface

contains
  subroutine describe(this)
    class(shape_t), intent(in) :: this
    print *, "Pos: (", this%x, ",", this%y, ")"
  end subroutine
end module

! File: triangle_mod.f90
module triangle_mod
  use shape_mod
  implicit none

  ! Tipo derivato: estende shape_t
  type, extends(shape_t) :: triangle_t
    ! x = base, y = altezza
  contains
    procedure :: area   ! override
  end type

contains
  function area(this) result(a)
    class(triangle_t), intent(in) :: this
    real :: a
    a = 0.5 * this%x * this%y
  end function
end module

! Uso nel main
use triangle_mod
type(triangle_t) :: tri
tri%x = 10.0
tri%y = 5.0
print *, "Area: ", tri%area()   ! 25.0
call tri%describe()           ! ereditato

! Array polimorfico di shapes
class(shape_t), allocatable :: shapes(:)

! SELECT TYPE: dispatch dinamico
class(shape_t), intent(in) :: s

select type(s)
type is (triangle_t)
  print *, "Triangolo, area=", s%area()
class is (shape_t)
  print *, "Forma generica"
end select

! Accesso a componenti padre
type, extends(shape_t) :: circle_t
  real :: radius
contains
  procedure :: area
end type

! Costruttore esplicito (F2003+)
type(circle_t) :: c
c = circle_t(shape_t(0.,0.), 5.0)

! SAME_TYPE_AS / EXTENDS_TYPE_OF
if (same_type_as(a, b)) ...
if (extends_type_of(a, b)) ...

module account_mod
  implicit none
  private   ! tutto privato di default

  type, public :: account_t
    private                  ! campi inaccessibili
    character(len=50) :: owner
    real              :: balance = 0.0
    integer           :: n_ops   = 0
  contains
    procedure :: get_balance
    procedure :: get_owner
    procedure :: deposit
    procedure :: withdraw
    procedure :: display
    procedure :: init
  end type

contains
  subroutine init(this, owner, balance)
    class(account_t), intent(inout) :: this
    character(*), intent(in)       :: owner
    real, intent(in), optional     :: balance
    this%owner = owner
    if (present(balance)) this%balance = balance
  end subroutine

  ! Getter (accesso controllato)
  pure real function get_balance(this)
    class(account_t), intent(in) :: this
    get_balance = this%balance
  end function

  pure function get_owner(this) result(s)
    class(account_t), intent(in) :: this
    character(len=50) :: s
    s = this%owner
  end function

  ! Setter con validazione
  subroutine deposit(this, amount)
    class(account_t), intent(inout) :: this
    real, intent(in) :: amount
    if (amount <= 0.0) then
      print *, "Errore: importo non valido"
      return
    end if
    this%balance = this%balance + amount
    this%n_ops = this%n_ops + 1
  end subroutine
end module account_mod

module vehicle_mod
  implicit none
  private

  ! Tipo base (padre)
  type, public :: vehicle_t
    character(len=30) :: brand
    integer           :: year
    real              :: speed = 0.0
  contains
    procedure :: describe => vehicle_describe
    procedure :: accelerate
  end type

  ! Tipo derivato (figlio)
  type, public, extends(vehicle_t) :: car_t
    integer :: n_doors = 4
    logical :: electric = .false.
  contains
    procedure :: describe => car_describe  ! override
  end type

  ! Secondo livello di ereditarietà
  type, public, extends(car_t) :: suv_t
    logical :: awd = .true.
  contains
    procedure :: describe => suv_describe
  end type

contains
  subroutine vehicle_describe(this)
    class(vehicle_t), intent(in) :: this
    print "(a,a,a,i4)", "Veicolo: ", &
      trim(this%brand), " Anno:", this%year
  end subroutine

  subroutine accelerate(this, delta)
    class(vehicle_t), intent(inout) :: this
    real, intent(in) :: delta
    this%speed = this%speed + delta
  end subroutine

  subroutine car_describe(this)
    class(car_t), intent(in) :: this
    ! Accesso a campi ereditati
    print "(a,a,a,i1,a,l1)", &
      trim(this%brand), ": ", &
      "Porte=", this%n_doors, &
      " Elettrica=", this%electric
  end subroutine

  subroutine suv_describe(this)
    class(suv_t), intent(in) :: this
    print "(a,a,a,l1)", trim(this%brand), &
      ": SUV, AWD=", this%awd
  end subroutine
end module vehicle_mod

! Uso:
type(car_t) :: c
c = car_t("Tesla", 2024, 0.0, 4, .true.)
call c%describe()     ! car_describe
call c%accelerate(60.0) ! ereditato

module animal_mod
  implicit none
  private

  ! Tipo ASTRATTO: non instanziabile
  type, abstract, public :: animal_t
    character(len=20) :: name
    integer           :: age = 0
  contains
    ! Metodo DEFERRED: DEVE essere implementato
    procedure(speak_if), deferred :: speak
    procedure(move_if),  deferred :: move
    ! Metodo concreto: ereditabile
    procedure :: info
  end type

  ! Interfacce astratte (contratto)
  abstract interface
    subroutine speak_if(this)
      import :: animal_t
      class(animal_t), intent(in) :: this
    end subroutine
    function move_if(this, dist) result(t)
      import :: animal_t
      class(animal_t), intent(in) :: this
      real, intent(in) :: dist
      real :: t
    end function
  end interface

  ! Implementazione concreta: dog_t
  type, public, extends(animal_t) :: dog_t
    real :: speed = 15.0  ! km/h
  contains
    procedure :: speak => dog_speak
    procedure :: move  => dog_move
  end type

  ! Implementazione concreta: fish_t
  type, public, extends(animal_t) :: fish_t
    real :: speed = 5.0
  contains
    procedure :: speak => fish_speak
    procedure :: move  => fish_move
  end type

contains
  subroutine info(this)
    class(animal_t), intent(in) :: this
    print *, trim(this%name), ", età:", this%age
  end subroutine

  subroutine dog_speak(this)
    class(dog_t), intent(in) :: this
    print *, trim(this%name), ": Bau!"
  end subroutine

  real function dog_move(this, dist)
    class(dog_t), intent(in) :: this
    real, intent(in) :: dist
    dog_move = dist / this%speed
  end function

  ! ... fish_speak, fish_move analoghi
end module animal_mod

! Subroutine polimorfica: accetta qualsiasi
! sottotipo di animal_t
subroutine make_noise(a)
  class(animal_t), intent(in) :: a
  call a%speak()   ! dispatch dinamico!
end subroutine

! Container polimorfico con CLASS
type :: animal_box
  class(animal_t), allocatable :: item
end type

! Array di box polimorfici
type(animal_box) :: zoo(10)

allocate(dog_t  :: zoo(1)%item)
allocate(fish_t :: zoo(2)%item)

! Iterazione polimorfica
do i = 1, 2
  call zoo(i)%item%speak()  ! chiama impl. corretta
end do

! SELECT TYPE: dispatch esplicito
subroutine process(a)
  class(animal_t), intent(in) :: a

  select type(a)
  type is (dog_t)
    print *, "Cane, velocità:", a%speed
  type is (fish_t)
    print *, "Pesce, velocità:", a%speed
  class is (animal_t)
    print *, "Animale generico"
  class default
    print *, "Tipo sconosciuto"
  end select
end subroutine

! Funzioni di introspezione tipo
if (same_type_as(a, b))    ...  ! tipo identico?
if (extends_type_of(a, b)) ...  ! a estende b?

type :: resource_t
  real, allocatable :: data(:)
  integer :: handle = -1
contains
  final :: resource_destroy
end type

subroutine resource_destroy(this)
  type(resource_t), intent(inout) :: this
  if (allocated(this%data)) then
    deallocate(this%data)
  end if
  if (this%handle > 0) then
    print *, "Rilascio handle", this%handle
    this%handle = -1
  end if
end subroutine

! Il FINAL viene chiamato automaticamente
! quando l'oggetto esce dallo scope

subroutine demo_final()
  type(resource_t) :: r

  allocate(r%data(1000))
  r%handle = 42
  ! ... usa r ...

end subroutine  ! ← resource_destroy() invocato

! Nota: FINAL accetta SOLO type(), non class()
! Ogni tipo nella gerarchia può avere il suo FINAL
! I FINAL sono chiamati dal tipo più derivato
! al tipo base (ordine inverso di costruzione)

! Compilare: gfortran -fcoarray=single prog.f90
! Runtime:   cafrun -np 4 ./prog

! Variabile coarray: allocata su ogni immagine
integer :: x[*]     ! scalare coarray
real :: arr(10)[*]  ! array coarray

! Numero immagine corrente / totale
print *, this_image(), num_images()

! Accesso a dati di altra immagine
x = 42
if (this_image() == 1) then
  print *, x[2]    ! x sull'immagine 2
end if

! Sincronizzazione
sync all     ! barriera globale
sync images(2)  ! attende immagine 2

! FORALL (F95): deprecato in favore DO CONCURRENT
forall (i=1:n, j=1:n, i /= j)
  a(i,j) = 0.0
end forall

! DO CONCURRENT (F2008): moderno
do concurrent (i=1:n, j=1:n)
  mat(i,j) = real(i) / real(j)
end do

! CRITICAL (F2008+)
critical
  counter = counter + 1
end critical

! CO_SUM, CO_MAX, CO_MIN (F2018)
real :: total[*]
total = local_sum
sync all
call co_sum(total)
if (this_image()==1) print*,"Somma:",total

! Con gfortran: file .F90 attiva preprocessor
! oppure: gfortran -cpp file.f90

#define MAX_SIZE 1000
#define SQUARE(x) ((x)*(x))

integer :: arr(MAX_SIZE)
real :: res = SQUARE(3.14)

! Compilazione condizionale
#ifdef DEBUG
  print *, "Debug info: x =", x
#endif

#if defined(MPI)
  use mpi
#elif defined(COARRAY)
  ! usa coarray
#else
  ! sequenziale
#endif

#undef DEBUG
#include "header.f90"

use iso_fortran_env, only: &
  stdin  => input_unit,  &
  stdout => output_unit, &
  stderr => error_unit

write(stderr,*) "Errore su stderr"
print *, compiler_version()
print *, compiler_options()

use iso_c_binding
implicit none

! Tipi scalari equivalenti
integer(c_int)      :: i    ! int
integer(c_long)     :: l    ! long
integer(c_int64_t)  :: i64  ! int64_t
real(c_float)       :: f    ! float
real(c_double)      :: d    ! double
character(c_char)   :: ch   ! char
logical(c_bool)     :: b    ! _Bool
type(c_ptr)         :: p    ! void*
type(c_funptr)      :: fp   ! function pointer

! Dichiarazione interfaccia C
interface
  integer(c_int) function c_abs(x) &
      bind(C, name="abs")
    use iso_c_binding
    integer(c_int), value :: x
  end function

  type(c_ptr) function c_malloc(size) &
      bind(C, name="malloc")
    use iso_c_binding
    integer(c_size_t), value :: size
  end function
end interface

! Uso
print *, c_abs(-42_c_int)   ! 42

! Funzione Fortran callable da C
function my_sum(a, b) result(s) bind(C, name="my_sum")
  use iso_c_binding
  integer(c_int), value, intent(in) :: a, b
  integer(c_int) :: s
  s = a + b
end function

! In C: extern int my_sum(int a, int b);

! Puntatori C ↔ Fortran
use iso_c_binding
real(c_double), pointer :: fptr(:)
type(c_ptr) :: cptr

! C pointer → Fortran pointer
call c_f_pointer(cptr, fptr, [100])

! Fortran → C pointer
real(c_double), target :: arr(100)
cptr = c_loc(arr)

! Stringa C (null-terminated)
character(len=6) :: s = "Hello" // c_null_char

integer :: a = 12, b = 10  ! 1100, 1010

print *, iand(a, b)    ! 8   = 1000
print *, ior(a, b)     ! 14  = 1110
print *, ieor(a, b)    ! 6   = 0110
print *, not(a)        ! complemento
print *, ishft(a, 2)   ! 48  = 110000
print *, ishft(a, -2)  ! 3   = 11

! Test/Set/Clear bit
print *, btest(a, 2)   ! .TRUE.  (bit 2)
print *, btest(a, 0)   ! .FALSE. (bit 0)
print *, ibset(a, 0)   ! 13 = 1101
print *, ibclr(a, 2)   ! 8  = 1000

! Info tipo
print *, bit_size(a)   ! 32 (default int)

! Leadz / Trailz / Popcnt (F2008+)
print *, leadz(a)      ! leading zeros
print *, trailz(a)     ! trailing zeros
print *, popcnt(a)     ! population count

character(8)  :: date_str
character(10) :: time_str
character(5)  :: zone_str
integer       :: vals(8)

call date_and_time(date_str, time_str, &
                   zone_str, vals)

! date_str = "20260329" (YYYYMMDD)
! time_str = "143025.123" (hhmmss.sss)
! vals(1) = anno, (2) = mese, (3) = giorno
! vals(4) = diff UTC min, (5) = ore
! vals(6) = minuti, (7) = secondi
! vals(8) = millisecondi

print "(i4,a,i2.2,a,i2.2)", &
  vals(1), "-", vals(2), "-", vals(3)

! CPU time (tempo processore)
real :: t1, t2

call cpu_time(t1)
! ... lavoro da misurare ...
call cpu_time(t2)
print *, "CPU time:", t2 - t1, "s"

! system_clock (wall-clock time)
integer(8) :: c1, c2, rate

call system_clock(c1, rate)
! ... lavoro da misurare ...
call system_clock(c2)
print *, "Wall time:", &
  real(c2 - c1) / real(rate), "s"

integer :: nargs, i
character(len=256) :: arg

! Numero argomenti (escluso nome programma)
nargs = command_argument_count()

! Argomento 0 = nome programma
call get_command_argument(0, arg)
print *, "Programma: ", trim(arg)

! Tutti gli argomenti
do i = 1, nargs
  call get_command_argument(i, arg)
  print *, "Arg", i, ": ", trim(arg)
end do

! Conversione argomento → numero
integer :: n, ierr
character(256) :: buf

call get_command_argument(1, buf)
read(buf, *, iostat=ierr) n
if (ierr /= 0) then
  print *, "Uso: prog <intero>"
  stop 1
end if

! Variabili d'ambiente
character(256) :: home
call get_environment_variable("HOME", home)
print *, "HOME = ", trim(home)

! Riga di comando completa
character(1024) :: cmdline
call get_command(cmdline)
print *, trim(cmdline)

! Alias temporaneo per espressioni complesse
type(particle_t) :: particles(1000)

associate (p => particles(idx), &
          v => particles(idx)%velocity, &
          n => size(particles))
  print *, p%x, p%y     ! accesso diretto
  v = v * 0.99           ! modifica originale
  print *, "N =", n
end associate

! Utile per leggibilità con struct annidate
associate (cfg => app%config%network%timeout)
  if (cfg > 30) cfg = 30   ! modifica in-place
end associate

! Blocco con scope locale per variabili
integer :: i = 10

block
  integer :: i = 99  ! nuova variabile locale
  real :: temp
  temp = sqrt(real(i))
  print *, i, temp   ! 99, 9.949...
end block

print *, i           ! 10 (invariato)

! Utile per allocazioni temporanee
block
  real, allocatable :: work(:)
  allocate(work(n))
  ! ... usa work ...
end block  ! work deallocato automaticamente

integer :: nx = 100, ny = 200
real    :: dt = 0.01, tmax = 10.0
character(20) :: method = "euler"

! Definizione namelist
namelist /params/ nx, ny, dt, tmax, method

! Scrittura su file
open(10, file="config.nml")
write(10, nml=params)
close(10)

! File generato (config.nml):
! &PARAMS
!  NX = 100, NY = 200,
!  DT = 0.01, TMAX = 10.0,
!  METHOD = "euler"
! /

! Lettura con valori di default
integer :: nx=10, ny=10, ierr
real :: dt=0.001, tmax=1.0
character(20) :: method="rk4"
namelist /params/ nx,ny,dt,tmax,method

open(10, file="config.nml", &
     status="old", iostat=ierr)
if (ierr == 0) then
  read(10, nml=params, iostat=ierr)
  close(10)
end if
! Solo variabili presenti nel file
! vengono aggiornate, le altre restano
! al valore di default

! Stampa su stdout per debug
write(*, nml=params)

! Fortran 2003: solo enum interoperabili con C
! I valori sono integer(c_int)
use iso_c_binding

enum, bind(C)
  enumerator :: RED = 0, GREEN = 1, BLUE = 2
end enum

! Valore automatico (incrementale)
enum, bind(C)
  enumerator :: MON     ! 0
  enumerator :: TUE     ! 1
  enumerator :: WED     ! 2
  enumerator :: THU = 10
  enumerator :: FRI     ! 11
end enum

! Uso come variabile
integer(c_int) :: day = MON
if (day == TUE) print *, "Martedì"

! Pattern comune pre-F2003 e più flessibile
integer, parameter :: &
  COLOR_RED   = 1, &
  COLOR_GREEN = 2, &
  COLOR_BLUE  = 3

! Con tipo custom per type-safety
type :: color_enum
  integer :: val
end type

type(color_enum), parameter :: &
  C_RED   = color_enum(1), &
  C_GREEN = color_enum(2), &
  C_BLUE  = color_enum(3)

! Condivisione variabili globali (F77)
! OGNI unità che usa il blocco deve dichiararlo

! === File: main.f90 ===
program main
  real :: x, y, z
  common /globals/ x, y, z
  x = 1.0; y = 2.0; z = 3.0
  call sub1()
end program

! === File: sub1.f90 ===
subroutine sub1()
  real :: a, b, c
  common /globals/ a, b, c
  ! a=1.0, b=2.0, c=3.0 (stessa memoria)
  print *, a, b, c
end subroutine

! Alternativa moderna: MODULE
module globals
  real :: x, y, z
end module

! Sovrappone variabili in memoria
real    :: r
integer :: i
equivalence (r, i)  ! stessa memoria

r = 3.14
print *, i  ! bit di r interpretati come int

! Uso tipico: array con alias diversi
real :: vec(6)
real :: mat(2,3)
equivalence (vec, mat)
! vec e mat condividono la stessa memoria

! Alternativa moderna: TRANSFER
integer :: ibits
ibits = transfer(3.14, ibits)

! DATA statement (inizializzazione F77)
real :: arr(5)
data arr /1.0, 2.0, 3.0, 4.0, 5.0/

! BLOCK DATA: inizializza COMMON
block data init_globals
  real :: x, y, z
  common /globals/ x, y, z
  data x,y,z /0.0, 0.0, 0.0/
end block data

# Compilazione base
gfortran programma.f90 -o prog

# Ottimizzazioni
gfortran -O0 prog.f90    # nessuna
gfortran -O2 prog.f90    # raccomandata
gfortran -O3 prog.f90    # massima

# Debug
gfortran -g -Wall -Wextra -fcheck=all prog.f90

# Standard Fortran specifico
gfortran -std=f2003 prog.f90
gfortran -std=f2008 prog.f90
gfortran -std=f2018 prog.f90

# Preprocessore
gfortran -cpp -DDEBUG prog.f90

# Moduli multipli
gfortran -c mod1.f90
gfortran -c mod2.f90
gfortran mod1.o mod2.o main.f90 -o prog

# Makefile semplice
FC     = gfortran
FFLAGS = -O2 -Wall -fcheck=all

all: prog

prog: main.f90 utils.f90
    $(FC) $(FFLAGS) -o $@ $^

clean:
    rm -f prog *.o *.mod