DIMENSION ILA(50,50,50),JCX(100000),JCY(100000),JCZ(100000)
!     ARRAY DIMENSION 
      MAX=50

!     INITIALIZE ARRAY
      DO I=1,MAX
       DO J=1,MAX
        DO K=1,MAX
           ILA(I,J,K)=1
        ENDDO
       ENDDO
      ENDDO
!     PREPARE AN FCC LATTICE
      DO 4 K=1,MAX,2
       DO I=1,MAX,2
        DO J=1,MAX,2
          ILA(I,J,K)=2
        ENDDO
       ENDDO
      DO I=2,MAX,2
       DO J=2,MAX,2
         ILA(I,J,K)=2
       ENDDO
      ENDDO
4     CONTINUE
      DO 7 K=2,MAX,2
       DO I=2,MAX,2
        DO J=1,MAX,2
          ILA(I,J,K)=2
        ENDDO
       ENDDO    
       DO I=1,MAX,2
        DO J=2,MAX,2
          ILA(I,J,K)=2
        ENDDO
       ENDDO    
7     CONTINUE

!     INTRODUCE A VACANCY
      IV1=1
      IV2=1
      IV3=1
      ILA(IV1,IV2,IV3)=0

!     LABEL THE OCCUPIED FCC LATTICE SITES
      M=0
      DO I=1,MAX
       DO J=1,MAX
        DO K=1,MAX
          IF(ILA(I,J,K).NE.2) GO TO 8
           M=M+1
           ILA(I,J,K)=M
8     CONTINUE           
        ENDDO
       ENDDO
      ENDDO 

!     INITIALIZE RUNNING COORDINATE FILES OF THE ATOMS
      DO 9 I=1,M
      JCX(I)=0
      JCY(I)=0
      JCZ(I)=0
9     CONTINUE

!     INITIALIZE RANDOM NUMBER GENERATOR
      IS=10

!     INITIALIZE JUMP COUNTER
      IJUMP=0

!     SET THE LIMIT FOR THE NUMBER OF JUMPS
      N=50000

!     START DIFFUSION 
!     GENERATE A RANDOM DIRECTION FROM THE 12 AVAILABLE
10    IDIR=12.0*RDM(IS)+11.0
!      print*,IDIR
!     BRANCH TO THAT DIRECTION 
      if (IDIR.EQ.11)THEN
        go to 11
      else if (IDIR.EQ.12)THEN
        go to 12
      else if (IDIR.EQ.13)THEN
        go to 13
      else if (IDIR.EQ.14)THEN
        go to 14
      else if (IDIR.EQ.15)THEN
        go to 15
      else if (IDIR.EQ.16)THEN
        go to 16
      else if (IDIR.EQ.17)THEN
        go to 17
      else if (IDIR.EQ.18)THEN
        go to 18
      else if (IDIR.EQ.19)THEN
        go to 19
      else if (IDIR.EQ.20)THEN
        go to 20
      else if (IDIR.EQ.21)THEN
        go to 21
      else if (IDIR.EQ.22)THEN
        go to 22
      end if

!     GENERATE COORDINATES OF ATOM NEIGHBORING TO VACANCY
11    continue
      K1=IV1+1
!     CHECK FOR BOUNDARY
      IF(K1.GT.MAX) K1=K1-MAX
      K2=IV2-1
      IF(K2.LT.1) K2=K2+MAX
      K3=IV3
!     DETERMINE IDENTITY OF ATOM 
      ID=ILA(K1,K2,K3)
!     JUMP
!     UPDATE RUNNING COORDINATES OF ATOM 'ID'
      JCX(ID)=JCX(ID)-1
      JCY(ID)=JCY(ID)+1
      GO TO 23

12    continue
      K1=IV1+1
      IF(K1.GT.MAX) K1=K1-MAX
      K2=IV2
      K3=IV3-1
      IF(K3.LT.1) K3=K3+MAX
      ID=ILA(K1,K2,K3)
      JCX(ID)=JCX(ID)-1
      JCZ(ID)=JCZ(ID)+1
      GO TO 23

13    continue
      K1=IV1+1
      IF(K1.GT.MAX) K1=K1-MAX
      K2=IV2+1
      IF(K2.GT.MAX) K2=K2-MAX
      K3=IV3
      ID=ILA(K1,K2,K3)
      JCX(ID)=JCX(ID)-1
      JCY(ID)=JCY(ID)-1
      GO TO 23

14    continue
      K1=IV1+1
      IF(K1.GT.MAX) K1=K1-MAX
      K2=IV2
      K3=IV3+1
      IF(K3.GT.MAX) K3=K3-MAX
      ID=ILA(K1,K2,K3)
      JCX(ID)=JCX(ID)-1
      JCZ(ID)=JCZ(ID)-1
      GO TO 23

15    continue
      K1=IV1-1
      IF(K1.LT.1) K1=K1+MAX
      K2=IV2+1
      IF(K2.GT.MAX) K2=K2-MAX 
      K3=IV3
      ID=ILA(K1,K2,K3)
      JCX(ID)=JCX(ID)+1
      JCY(ID)=JCY(ID)-1
      GO TO 23

16    continue
      K1=IV1-1
      IF(K1.LT.1) K1=K1+MAX
      K2=IV2
      K3=IV3+1
      IF(K3.GT.MAX) K3=K3-MAX
      ID=ILA(K1,K2,K3)
      JCX(ID)=JCX(ID)+1
      JCZ(ID)=JCZ(ID)-1
      GO TO 23

17    continue
      K1=IV1-1
      IF(K1.LT.1) K1=K1+MAX
      K2=IV2-1
      IF(K2.LT.1) K2=K2+MAX
      K3=IV3
      ID=ILA(K1,K2,K3)
      JCX(ID)=JCX(ID)+1
      JCY(ID)=JCY(ID)+1
      GO TO 23

18    continue
      K1=IV1-1
      IF(K1.LT.1) K1=K1+MAX
      K2=IV2
      K3=IV3-1
      IF(K3.LT.1) K3=K3+MAX
      ID=ILA(K1,K2,K3)
      JCX(ID)=JCX(ID)+1
      JCZ(ID)=JCZ(ID)+1
      GO TO 23

19    continue
      K1=IV1
      K2=IV2+1
      IF(K2.GT.MAX) K2=K2-MAX
      K3=IV3-1
      IF(K3.LT.1) K3=K3+MAX
      ID=ILA(K1,K2,K3)
      JCY(ID)=JCY(ID)-1
      JCZ(ID)=JCZ(ID)+1
      GO TO 23

20    continue
      K1=IV1
      K2=IV2+1
      IF(K2.GT.MAX) K2=K2-MAX
      K3=IV3+1
      IF(K3.GT.MAX) K3=K3-MAX
      ID=ILA(K1,K2,K3)
      JCY(ID)=JCY(ID)-1
      JCZ(ID)=JCZ(ID)-1
      GO TO 23

21    continue
      K1=IV1
      K2=IV2-1
      IF(K2.LT.1) K2=K2+MAX
      K3=IV3+1
      IF(K3.GT.MAX) K3=K3-MAX
      ID=ILA(K1,K2,K3)
      JCY(ID)=JCY(ID)+1
      JCZ(ID)=JCZ(ID)-1
      GO TO 23

22    continue
      K1=IV1
      K2=IV2-1
      IF(K2.LT.1) K2=K2+MAX
      K3=IV3-1
      IF(K3.LT.1) K3=K3+MAX
      ID=ILA(K1,K2,K3)
      JCY(ID)=JCY(ID)+1
      JCZ(ID)=JCZ(ID)+1
      GO TO 23

23    CONTINUE
!     INTERCHANGE ATOM AND VACANCY
      ILA(K1,K2,K3)=0
      ILA(IV1,IV2,IV3)=ID
!     UPDATE VACANCY COORDINATES
      IV1=K1
      IV2=K2
      IV3=K3

!     UPDATE JUMP COUNTER
      IJUMP=IJUMP+1
!     TEST AGAINST JUMP LIMIT
      IF(IJUMP.LT.N) GO TO 10

!     CALCULATE F FROM ATOM DISPLACEMENTS
      RSQ=0.0
      DO 24 I=1,M
      RSQ=RSQ+JCX(I)**2+JCY(I)**2+JCZ(I)**2
24    CONTINUE
      F=RSQ/(FLOAT(IJUMP)*2.0)
      PRINT 25,F,IJUMP,M
25    FORMAT(4X,'F=', F7.6, 5X,', NO. OF VANCANY JUMPS=', I7, 5X, ', NO. OF ATOMS=',I7)

      STOP 
      END

      REAL FUNCTION RDM(I)
!     CREATE A RANDOM NUMBER IN THE INTERVAL[0..1)
      INTEGER(4) A,B,M,I
      PARAMETER(A=2037, B=3147769, M=1048576)
      REAL(8) X,Y
!     WRITE(*,*)A,B,M,'I=',I
      Y=I
      Y=A*Y+B
!     write(*,*) 'A*I+B=',Y
!     WRITE(*,*)'Y/M',Y/M,',    AINT(Y/M)=',AINT(Y/M)
      X=Y-M*AINT(Y/M)
!     write(*,*)'X=',x
      I=INT(X)
!     WRITE(*,*)' I=',I
      RDM=X/M
!     X=MOD(A*X+B,M)
!     RDM=FLOAT(X)/M
      RETURN
      END
 
by

Fortran Online Compiler

Write, Run & Share Fortran code online using OneCompiler's Fortran online compiler for free. It's one of the robust, feature-rich online compilers for Fortran language, running on the latest version 7. Getting started with the OneCompiler's Fortran compiler is simple and pretty fast. The editor shows sample boilerplate code when you choose language as Fortran and start coding.

Read inputs from stdin

OneCompiler's Fortran online editor supports stdin and users can give inputs to programs using the STDIN textbox under the I/O tab. Following is a sample Fortran program which takes name as input and prints hello message with your name.

program hello
  character :: name*30
  read *, name
	print *, "Hello ", name
end program hello

About Fortran

Fortran language was initially developed for scientific calculations by IBM in 1957. It has a number of in-built functions to perform mathematical calculations and is ideal for applications which has more mathematical calculations.

Syntax help

Data Types

Data typeDescriptionUsage
IntegerTo store integer variablesinteger :: x
RealTo store float valuesreal :: x
ComplexTo store complex numberscomplex :: x,y
LogicalTo store boolean values True or falselogical :: x=.True. , logical :: x = .FALSE.
CharacterTo store characters and stringscharacter :: x

Variables

Variable is a name given to the storage area in order to manipulate them in our programs.

data type :: variable_name

Arrays

Array is a collection of similar data which is stored in continuous memory addresses.

Syntax

data-type, dimension (x,y) :: array-name

Example

integer, dimension(3,3) :: cube

Loops

1. Do:

Do is used to execute a set of statement(s) iteratively when a given condition is true and the loop variable must be an integer.

do i = start, stop [,step]    
   ! code
end do

2. Do-While:

Do-While is used to execute a set of statement(s) iteratively when a given condition is true.

do while (condition) 
   !Code
end do

3. If:

If is used to execute a set of statements based on a condition.

if (logical-expression) then      
   !Code  
end if

4. If-Else:

If is used to execute a set of statements based on a condition and execute another set of statements present in else block, if condition specified in If block fails.

if (logical-expression) then     
   !code when the condition is true
else
   !code when the condition fails
end if

5. Case:

Case is similar to switch in C language.

[name:] select case (regular-expression) 
   case (value1)          
   ! code for value 1          
   ... case (value2)           
   ! code for value 2           
   ...       
   case default          
   ! default code          
   ...   
end select [name]