1! Test allocation and deallocation.
2program test_allocate
3  call t1 (.true.)
4  call t1 (.false.)
5  call t2
6contains
7
8! Implicit deallocation and saved aloocated variables.
9subroutine t1(first)
10  real, allocatable, save :: p(:)
11  real, allocatable :: q(:)
12  logical first
13
14  if (first) then
15    if (allocated (p)) STOP 1
16  else
17    if (.not. allocated (p)) STOP 2
18  end if
19  if (allocated (q)) STOP 3
20
21  if (first) then
22    allocate (p(5))
23  else
24    deallocate (p)
25  end if
26  allocate (q(5))
27end subroutine
28
29! Explicit deallocation.
30subroutine t2()
31  real, allocatable :: r(:)
32
33  allocate (r(5))
34  pr = 1.0
35  deallocate (r)
36  if (allocated(r)) STOP 4
37end subroutine
38end program
39