Variables, Declarations and Attributes

declaration-type-spec [ [ , attr-spec ] ... :: ] entity-decl-list

module heatflow_kinds
  use, intrinsic :: iso_fortran_env, only: int32, int64, real32, real64
  implicit none
  private
  public :: sp, dp, ip, lp
  integer, parameter :: sp = real32
  integer, parameter :: dp = real64
  integer, parameter :: ip = int32
  integer, parameter :: lp = int64
end module heatflow_kinds

program declarations
  use heatflow_kinds, only: dp, ip
  implicit none

  ! Attributes in the attribute list apply to every entity in the statement.
  real(dp), parameter :: lx = 1.0_dp, ly = 0.5_dp
  integer(ip), parameter :: nx = 5_ip, ny = 3_ip

  ! dimension in the attribute list gives a default shape ...
  real(dp), dimension(nx, ny) :: u, unew
  ! ... that an array-spec in the entity-decl overrides (here: a vector).
  real(dp), dimension(nx, ny) :: u0, probe(nx)

  ! A character length can be overridden per entity with *len.
  character(len=8) :: label, short*4

  ! Initialization appears in the entity-decl (and needs the :: separator).
  integer(ip) :: step = 0_ip
  logical :: converged = .false.

  u = 0.0_dp
  unew = 0.0_dp
  u0 = 20.0_dp
  probe = u0(:, 1)
  label = 'plate'
  short = 'abcd'

  print '(a, 2i3)', 'shape of u:        ', shape(u)
  print '(a, 2i3)', 'shape of u0:       ', shape(u0)
  print '(a, i3)', 'size of probe:     ', size(probe)
  print '(a, i3, a, i3)', 'len(label):        ', len(label), '  len(short): ', len(short)
  print '(a, a)', 'short:              ', short
  print '(a, i3, l2)', 'step, converged:   ', step, converged
  print '(a, f5.2)', 'dx:                ', lx/real(nx - 1_ip, dp)
  print '(a, f5.2)', 'dy:                ', ly/real(ny - 1_ip, dp)
end program declarations

shape of u:          5  3
shape of u0:         5  3
size of probe:       5
len(label):          8  len(short):   4
short:              abcd
step, converged:     0 F
dx:                 0.25
dy:                 0.25

! Deliberately legacy code: there is no IMPLICIT NONE, so a misspelt name is
! silently a new implicitly typed variable. Do not write programs like this.
program implicit_legacy
  total = 0.0
  do i = 1, 3
    total = total + 0.5
  end do
  ! Typing error: "totl" is a brand new variable of default real, value undefined.
  half = totl / 2.0
  n = 7
  x = 7 / 2
  print *, 'i is ', i, ' (letters I-N are integer)'
  print *, 'total =', total
  print *, 'x = 7/2 gives', x, ' n/2 gives', n/2
  print *, 'a typo-variable was compiled without a single error'
end program implicit_legacy

 i is            4  (letters I-N are integer)
 total =   1.50000000
 x = 7/2 gives   3.00000000      n/2 gives           3
 a typo-variable was compiled without a single error

module heatflow_kinds
  use, intrinsic :: iso_fortran_env, only: int32, real64
  implicit none
  private
  public :: dp, ip
  integer, parameter :: dp = real64
  integer, parameter :: ip = int32
end module heatflow_kinds

program block_construct
  use heatflow_kinds, only: dp, ip
  implicit none
  real(dp) :: u(6), residual
  real(dp) :: tmp
  integer(ip) :: n, pass

  u = [0.0_dp, 4.0_dp, 8.0_dp, 8.0_dp, 4.0_dp, 0.0_dp]
  n = size(u, kind=ip)
  tmp = -1.0_dp

  ! A block with its own declarations: they exist only inside the construct.
  smoothing: block
    real(dp) :: work(n)                  ! automatic array sized at run time
    real(dp) :: tmp                      ! hides the outer tmp, never touches it
    integer :: i

    work = u
    do i = 2, int(n) - 1
      tmp = 0.5_dp*(work(i - 1) + work(i + 1))
      u(i) = 0.5_dp*(work(i) + tmp)
    end do
    residual = maxval(abs(u - work))
    if (residual < 1.0e-12_dp) exit smoothing   ! leave the construct early
    print '(a, es9.2)', 'residual after one sweep: ', residual
  end block smoothing

  print '(a, f5.1)', 'outer tmp unchanged: ', tmp
  print '(a, 6f6.2)', 'u: ', u

  ! A saved variable inside a block keeps its value between executions.
  do pass = 1_ip, 3_ip
    block
      integer, save :: visits = 0
      visits = visits + 1
      print '(a, i0, a, i0)', 'pass ', pass, ', visits ', visits
    end block
  end do
end program block_construct

residual after one sweep:  1.00E+00
outer tmp unchanged:  -1.0
u:   0.00  4.00  7.00  7.00  4.00  0.00
pass 1, visits 1
pass 2, visits 2
pass 3, visits 3

module heatflow_kinds
  use, intrinsic :: iso_fortran_env, only: int32, int64, real32, real64
  implicit none
  private
  public :: sp, dp, ip, lp
  integer, parameter :: sp = real32
  integer, parameter :: dp = real64
  integer, parameter :: ip = int32
  integer, parameter :: lp = int64
end module heatflow_kinds

program named_constants
  use heatflow_kinds, only: dp, ip
  implicit none

  ! Constant expressions: literals, other named constants and intrinsic
  ! functions of constant arguments.
  real(dp), parameter :: pi = 4.0_dp*atan(1.0_dp)
  real(dp), parameter :: lx = 1.0_dp, ly = 0.5_dp
  integer(ip), parameter :: nx = 41_ip
  integer(ip), parameter :: ny = nint(real(nx - 1_ip, dp)*ly/lx) + 1_ip

  ! A named array constant; the implied shape (*) takes its extent from the value.
  integer(ip), parameter :: sample_i(*) = [1_ip, (nx - 1_ip)/2_ip + 1_ip, nx]
  ! The kind of a real can itself come from a constant expression.
  integer, parameter :: wide = selected_real_kind(p=15, r=300)
  real(wide), parameter :: tiny_value = tiny(1.0_wide)

  ! Character constants: the length can be assumed from the value.
  character(len=*), parameter :: title = 'heatflow plate'
  character(len=*), parameter :: names(3) = ['dirichlet', 'neumann  ', 'periodic ']

  ! A derived-type constant built from a structure constructor.
  type :: point_t
    real(dp) :: x, y
  end type point_t
  type(point_t), parameter :: origin = point_t(0.0_dp, 0.0_dp)

  ! A constant expression can use array inquiry and transformational functions.
  integer(ip), parameter :: total = sum(sample_i)
  integer, parameter :: nsamples = size(sample_i)

  print '(a, f10.7)', 'pi:            ', pi
  print '(a, i0, a, i0)', 'grid:          ', nx, ' x ', ny
  print '(a, i0, a, 3i4)', 'samples:       ', nsamples, ' -> ', sample_i
  print '(a, i0)', 'sum of samples:', total
  print '(a, i0, a, i0)', 'wide kind:     ', wide, ', digits ', digits(1.0_wide)
  print '(a, es12.3e3)', 'tiny(wide):    ', tiny_value
  print '(3a, i0)', 'title:         "', title, '", length ', len(title)
  print '(a, a)', 'names(2):      ', trim(names(2))
  print '(a, 2f4.1)', 'origin:        ', origin%x, origin%y
end program named_constants

pi:             3.1415927
grid:          41 x 21
samples:       3 ->    1  21  41
sum of samples:63
wide kind:     8, digits 53
tiny(wide):      2.225E-308
title:         "heatflow plate", length 14
names(2):      neumann
origin:         0.0 0.0

! Intentionally invalid: a named constant cannot be redefined.
program error_parameter
  implicit none
  integer, parameter :: nx = 41
  nx = 81
  print *, nx
end program error_parameter

11_error_parameter.f90:5:3:

    5 |   nx = 81
      |   1~~
Error: Named constant 'nx' in variable definition context (assignment) at (1)

module heatflow_kinds
  use, intrinsic :: iso_fortran_env, only: int32, real64
  implicit none
  private
  public :: dp, ip
  integer, parameter :: dp = real64
  integer, parameter :: ip = int32
end module heatflow_kinds

module step_counter
  use heatflow_kinds, only: dp, ip
  implicit none
  private
  public :: next_with_init, next_without_init, next_with_save, ticks
  ! Module variables always have the save attribute.
  integer(ip) :: ticks = 0_ip
contains
  function next_with_init() result(n)
    integer(ip) :: n
    integer(ip) :: count = 0_ip      ! explicit initialization implies save
    count = count + 1_ip
    n = count
  end function next_with_init

  function next_without_init() result(n)
    integer(ip) :: n
    integer(ip) :: count
    count = 0_ip                     ! executable assignment: runs on every call
    count = count + 1_ip
    n = count
  end function next_without_init

  function next_with_save() result(n)
    integer(ip) :: n
    integer(ip), save :: count        ! save without initialization: undefined at first
    logical, save :: first = .true.   ! a guard written in the modern style
    if (first) then
      count = 0_ip
      first = .false.
    end if
    count = count + 1_ip
    n = count
    ticks = ticks + 1_ip
  end function next_with_save
end module step_counter

program initialization_and_save
  use heatflow_kinds, only: dp, ip
  use step_counter
  implicit none
  integer :: k
  real(dp) :: a(4)
  integer(ip) :: m(2, 3)
  integer :: i, j
  character(len=3) :: tag(2)
  real(dp), pointer :: p => null()

  ! DATA statement: the same effect as initialization in the declaration.
  data a /1.0_dp, 2.0_dp, 2*3.0_dp/
  data ((m(i, j), i=1, 2), j=1, 3) /1_ip, 2_ip, 3_ip, 4_ip, 5_ip, 6_ip/
  data tag(1) /'abc'/, tag(2) /'xyz'/

  do k = 1, 3
    print '(a, i0, a, 3(i0, 1x))', 'call ', k, ': init/noinit/save = ', &
      next_with_init(), next_without_init(), next_with_save()
  end do
  print '(a, i0)', 'ticks (module variable): ', ticks
  print '(a, 4f4.1)', 'a: ', a
  print '(a, 6i2)', 'm in array element order: ', m
  print '(a, 2(a, 1x))', 'tag: ', tag
  print '(a, l2)', 'p associated: ', associated(p)
end program initialization_and_save

call 1: init/noinit/save = 1 1 1
call 2: init/noinit/save = 2 1 2
call 3: init/noinit/save = 3 1 3
ticks (module variable): 3
a:  1.0 2.0 3.0 3.0
m in array element order:  1 2 3 4 5 6
tag: abc xyz
p associated:  F

! Intentionally wrong: "residual" is never defined when the loop does not run.
! Compile with -finit-real=snan -ffpe-trap=invalid to make the bug visible.
program error_uninitialized
  use, intrinsic :: iso_fortran_env, only: dp => real64
  implicit none
  real(dp) :: residual
  integer :: step, nsteps

  nsteps = 0
  do step = 1, nsteps
    residual = 1.0_dp/real(step, dp)
  end do
  if (residual < 1.0e-6_dp) then
    print '(a)', 'converged'
  else
    print '(a)', 'not converged'
  end if
end program error_uninitialized

Program received signal SIGFPE: Floating-point exception - erroneous arithmetic operation.

Backtrace for this error:
...
#3  0x4008b8 in error_uninitialized
	at 16_error_uninitialized.f90:13
Floating point exception

module heatflow_kinds
  use, intrinsic :: iso_fortran_env, only: int32, real64
  implicit none
  private
  public :: dp, ip
  integer, parameter :: dp = real64
  integer, parameter :: ip = int32
end module heatflow_kinds

module smoothing
  use heatflow_kinds, only: dp, ip
  implicit none
  private
  public :: smooth, padded_width
contains
  ! A specification function: pure, not internal, not an intrinsic. It may
  ! appear in the declarations of other procedures.
  pure function padded_width(n) result(w)
    integer(ip), intent(in) :: n
    integer(ip) :: w
    w = n + 2_ip
  end function padded_width

  subroutine smooth(u, label)
    real(dp), intent(inout) :: u(:, :)
    character(len=*), intent(in) :: label

    ! Automatic objects: their shape and length come from specification
    ! expressions evaluated each time the procedure is entered.
    real(dp) :: work(size(u, 1), size(u, 2))
    real(dp) :: halo(padded_width(int(size(u, 1), ip)))
    character(len=len(label) + 5) :: banner
    integer :: i, j

    work = u
    do j = 2, size(u, 2) - 1
      do i = 2, size(u, 1) - 1
        u(i, j) = 0.25_dp*(work(i - 1, j) + work(i + 1, j) + work(i, j - 1) + work(i, j + 1))
      end do
    end do
    halo = 0.0_dp
    banner = '[' // label // '] ok'
    print '(a, 2i3, a, i3, a, a)', 'work shape', shape(work), '  halo size', size(halo), '  ', banner
  end subroutine smooth
end module smoothing

program specification_expressions
  use heatflow_kinds, only: dp
  use smoothing, only: smooth
  implicit none
  real(dp) :: small(4, 4), large(6, 5)

  small = 0.0_dp
  small(2:3, 2:3) = 8.0_dp
  large = 1.0_dp
  call smooth(small, 'small')
  call smooth(large, 'large plate')
  print '(a, 4f6.2)', 'small(2, :) = ', small(2, :)
end program specification_expressions

work shape  4  4  halo size  6  [small] ok
work shape  6  5  halo size  8  [large plate] ok
small(2, :) =   0.00  4.00  4.00  0.00

module heatflow_kinds
  use, intrinsic :: iso_fortran_env, only: int32, real64
  implicit none
  private
  public :: dp, ip
  integer, parameter :: dp = real64
  integer, parameter :: ip = int32
end module heatflow_kinds

! Attribute specification statements: each attribute is given in a separate
! statement after the type declaration. Every entity could instead be written
! in one declaration, for example "real(dp), parameter, public :: gain = 2.0_dp".
module probe_bank
  use heatflow_kinds, only: dp, ip
  implicit none
  private

  integer(ip) :: nprobes
  real(dp) :: gain
  real(dp) :: readings
  dimension readings(3)
  parameter (nprobes = 3_ip, gain = 2.0_dp)
  public :: nprobes, gain, readings, record
  protected :: readings

contains

  subroutine record(k, reading)
    integer(ip) :: k
    real(dp) :: reading
    value :: k
    intent(in) :: reading
    readings(k) = reading*gain
  end subroutine record

end module probe_bank

program attribute_statements
  use heatflow_kinds, only: ip, dp
  use probe_bank
  implicit none
  integer(ip) :: k

  do k = 1_ip, nprobes
    call record(k, real(k, dp))
  end do
  print '(a, i0, a, f4.1)', 'nprobes = ', nprobes, ', gain = ', gain
  print '(a, 3f5.1)', 'readings: ', readings
end program attribute_statements

nprobes = 3, gain =  2.0
readings:   2.0  4.0  6.0