!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!  Program file name: percolate.f90                                       !
!                                                                         !
!  © Tao Pang 2006                                                        !
!                                                                         !
!  Last modified: November 13, 2009                                       !
!                                                                         !
!  (1) This F90 program is created for the book, "An Introduction to      !
!      Computational Physics, 2nd Edition," written by Tao Pang and       !
!      published by Cambridge University Press on January 19, 2006.       !
!                                                                         !
!  (2) No warranties, express or implied, are made for this program.      !
!                                                                         !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
MODULE CSEED
  INTEGER :: SEED
END MODULE CSEED
!
PROGRAM PERCOLATE
!
! An example of creating a 2-dimensional percolation lattice.
!
  USE CSEED
  IMPLICIT NONE
  INTEGER, PARAMETER :: N = 10
  INTEGER :: I, J
  INTEGER :: IC
  INTEGER, DIMENSION (9) :: T
  REAL :: P, RANF
  LOGICAL, DIMENSION (N,N) :: L
!
! Initiate the seed from the current date and time
!
  CALL DATE_AND_TIME(VALUES = T)
  SEED = T(1)+70*(T(2)+12*(T(3)+31*(T(5)+23*(T(6)+59*T(7)))))
  IF (MOD(SEED,2).EQ.0) SEED = SEED-1
!
  P = RANF()
  DO I = 1, N
    DO J = 1, N
      CALL LATTICE (L, N, P)
      IF (L(I,J)) THEN
        WRITE (6, *) "1"
      ELSE
        WRITE (6, *) "0"
      END IF
    END DO
  END DO
END PROGRAM PERCOLATE

SUBROUTINE LATTICE (L, N, P)
!
! Subroutine to create a two-dimenisonal percolation lattice.
!
  INTEGER, INTENT (IN) :: N
  REAL, INTENT (IN) :: P
  REAL:: R, RANF
  LOGICAL, INTENT (OUT), DIMENSION (N,N) :: L
!
  DO I = 1, N
    DO J = 1, N
      R = RANF()
      IF(R.LT.P) THEN
        L(I,J) = .TRUE.
      ELSE
        L(I,J) = .FALSE.
      END IF
    END DO
  END DO
END SUBROUTINE LATTICE
!
FUNCTION RANF() RESULT (CR)
!
! Function to generate a uniform random number in [0,1]
! following x(i+1)=a*x(i) mod c with a=7** 5 and
! c=2** 31-1.  Here the seed is a global variable.
!
  USE CSEED
  IMPLICIT NONE
  INTEGER :: H, L, T, A, C, Q, R
  DATA A/16807/, C/2147483647/, Q/127773/, R/2836/
  REAL :: CR
!
  H = SEED/Q
  L = MOD(SEED, Q)
  T = A*L - R*H
  IF (T .GT. 0) THEN
    SEED = T
  ELSE
    SEED = C + T
  END IF
  CR = SEED/FLOAT(C)
END FUNCTION RANF