! Program Example from "Essential Fortran 90 & 95" by Loren P. Meissner
! Copyright 1996. Copying for sale requires permission from the author.
! Otherwise, distribution is permitted if these three lines are included.

  module F32M
    implicit none
    public :: Fill, Transition
    integer, parameter, private :: L = 16
    integer, dimension(L, L, L), private, save :: Ising
  contains
    subroutine Transition( )
      real, dimension(0: 6), parameter :: THRESHOLD = (/ 0.6, 0.5, 0.4, 0.3, 0.2, 0.1, 0.0 /)
      integer, dimension(L, L, L) :: Counter
      real, dimension(L, L, L) :: T, Ram
      integer :: I
  ! start subroutine Transition
      Counter = cshift( Ising, shift = -1, dim = 1 ) &
        + cshift( Ising, shift = 1, dim = 1 ) &
        + cshift( Ising, shift = -1, dim = 2 ) &
        + cshift( Ising, shift = 1, dim = 2 ) &
        + cshift( Ising, shift = -1, dim = 3 ) &
        + cshift( Ising, shift = 1, dim = 3 )
      Counter = merge( 6 - Counter, Counter, Ising == 0 )
      T = 0.0
      do I = 0, 6
        T = merge( THRESHOLD(I), T, Counter == I )
      end do
      call random_number( harvest = Ram )
      Ising = merge( 1 - Ising, Ising, Ram < T )
      write (unit = *, fmt = "(' ', 64 A1)" ) merge( "+", "-", Ising(: 4, : 4, : 4)  == 1 )
    return
    end subroutine Transition
    subroutine Fill( )
      integer :: L1, L2, L3
      real :: Ram
  ! start subroutine Fill
      do L1 = 1, L
        do L2 = 1, L
          do L3 = 1, L
            call random_number( harvest = Ram )
            Ising(L1, L2, L3) = merge (1, 0, Ram >= 0.5)
          end do
        end do
      end do
      write (unit = *, fmt = "(' ', 64 A1)" ) merge( "+", "-", Ising(: 4, : 4, : 4)  == 1 )
      return
    end subroutine Fill
  end module F32M

