Calculation of SRO (Short-Range Order) for fcc binary alloys.


!---------------------------------------------------------------------
! Fourie Transfer using α parameter
!
!      For fcc Binary Alloy
!
!
!             By H. Abe    Jul.11, 2000
!---------------------------------------------------------------------
!  r(lmn)=l(a1/2)+m(a2/2)+n(a3/2)
!
!  K(h1,h2,h3) = h1(a1*) + h2(a2*) + h3(a3*)
!
!  Isro=Σα(lmn)exp(2πK・r)
!
!  Isro=Σα(lmn)cos(πh1・l)cos(πh2・m) cos(πh3・n)
!
!-----------------------------------------------------------------------
 PROGRAM Fourie_SRO
  integer, parameter                         :: dp=selected_real_kind(10)
  Real,dimension(:), allocatable             :: alp
  Real,dimension(:,:), allocatable           :: h1,h2,h3
  integer,dimension(:), allocatable          :: l, m, n
  real (kind=dp)      :: pi, S, dS, S1, S2, S3
  real                :: w1, w2, w3, w4, w5,Hs,Ks,He,Ke, Q1,Q2,Q3
  integer             :: eof, mul, nD, nH, nK, nAlp,     L1,L2,L3
  Character (Len=50)  :: File_input, File_output
  external               map_hk
  pi = 3.1415926535
!--------------------------------------------
!   Open DATA File of α parameter
!-------------------------------------------
  File_input='AuCr18.dat'
  File_input='AgMn20spin.dat'
!  File_input='Laue_test.dat'

  File_output='SRO_'//trim(File_input)
  i=0
  open( 2,FILE=File_input )
    do
      i = i + 1
   read(2,*,IOSTAT=eof) w1,w2,w3,w4,mul,w5
!      write(*,'(I4,4F10.5)') i, w1,w2,w3,w5
!      read(*,*) aaaaa
      if (eof/=0) exit
 end do
  close(2)
  nD=i-1
  ALLOCATE( l(nD), m(nD), n(nD), alp(nD))
 !----------------------------------------------------------------
   open( 2,FILE=File_input )
    do i=1,nD
      read(2,*)                 l(i), m(i), n(i), w4, mul, alp(i)
      write(*,'(4I4,F10.5)') i, l(i), m(i), n(i), alp(i)
    end do
  close(2)
!----------------------------------------------------------------
!   Set K (h1, h2, h3) for map
!----------------------------------------------------------------
  nH=41; nK=41
  Hs=0.0; Ks=0.0
  He=2.0; Ke=2.0
  ALLOCATE( h1(nH,nK), h2(nH,nK), h3(nH,nK) )
  call map_hk (h1, h2, h3, nH, nK, Hs, Ks, He)
  nAlp=50     ! nAlp<= nD: Max number of n-th neighbor
  nAlp=nD
!----------------------------------------------------------------
!   Fourier Transfer
!----------------------------------------------------------------
  write(*,*) '----------------------------------------'
  write(*,'(A20,2F10.3)') '(Hs, Ks)       = ', Hs, Ks
  write(*,'(A20,2F10.3)') '(He, Ke)       = ', He, Ke
  write(*,'(A20,I10)')    'Total Points   = ', nH*nK
  write(*,'(A20,I10)')    'max neighbor   = ', nAlp
  write(*,'(A20,A30)')    'Filename (Out) = ', File_output
  write(*,*) '----------------------------------------'
  write(*,*) 'Calculation Start?'
  read(*,*) aaaaa
!----------------------------------------------------------------
  open( 8,FILE=File_output )
 write(8,'(A20,I10)') ' max neighbor = ', nAlp
    do i=1, nH
      do j=1, nK
     S = alp(1)
     Q1=h1(i,j); Q2=h2(i,j); Q3=h3(i,j)
     do k=2, nAlp                                ! k = 1 (0 0 0)
    L1=l(k); L2=m(k); L3=n(k)
    if    (L2==0.and.L3==0) then !-------------------  6 (L 0 0)
      S1=cos(pi*Q1*L1)
      S2=cos(pi*Q2*L1)
      S3=cos(pi*Q3*L1)
      dS=2.0*(S1+S2+S3) ! (l00) (-l00)
       elseif(L1==L2.and.L3==0) then !------------------ 12 (L L 0)
      S1=cos(pi*Q1*L1)*cos(pi*Q2*L1)                                ! (ll0)
      S2=cos(pi*Q1*L1)*cos(pi*Q3*L1)                                ! (l0l)
      S3=cos(pi*Q2*L1)*cos(pi*Q3*L1)                                ! (0ll)
      dS=4.0*(S1+S2+S3) ! (ll0) (-ll0) (l-l0) (-l-l0)
          elseif(L1/=L2.and.L3==0) then !----------------- 24 (L M 0)
      S1=cos(pi*Q1*L1)*cos(pi*Q2*L2) + cos(pi*Q1*L2)*cos(pi*Q2*L1) ! (lm0) (ml0)
      S2=cos(pi*Q1*L1)*cos(pi*Q3*L2) + cos(pi*Q1*L2)*cos(pi*Q3*L1)  ! (l0m) (m0l)
      S3=cos(pi*Q2*L1)*cos(pi*Q3*L2) + cos(pi*Q2*L2)*cos(pi*Q3*L1) ! (0lm) (0ml)
        dS=4.0*(S1+S2+S3) ! (lm0) (-lm0) (l-m0) (-l-m0)
     elseif(L1==L2.and.L2==L3) then !-----------------  8 (L L L)
      S1=cos(pi*Q1*L1)*cos(pi*Q2*L1)*cos(pi*Q3*L1)     ! (lll)
      dS=8.0*S1         ! (lll) (-lll) (l-ll) (ll-l) (-l-ll) (-ll-l) (l-l-l) (-l-l-l)
   elseif(L1==L2.and.L2/=L3.and.L3/=0) then !------- 24 (L L N)
      S1=cos(pi*Q1*L1)*cos(pi*Q2*L1)*cos(pi*Q3*L3)                 ! (lln)
      S2=cos(pi*Q1*L1)*cos(pi*Q2*L3)*cos(pi*Q3*L1)     ! (lnl)
      S3=cos(pi*Q1*L3)*cos(pi*Q2*L1)*cos(pi*Q3*L1)     ! (nll)
      dS=8.0*(S1+S2+S3) ! (lln) (-lln) (l-ln) (ll-n) (-l-ln) (-ll-n) (l-l-n) (-l-l-n)
    elseif(L1/=L2.and.L2==L3.and.L3/=0) then !------- 24 (L M M)
         S1=cos(pi*Q1*L1)*cos(pi*Q2*L2)*cos(pi*Q3*L2)                 ! (lmm)
      S2=cos(pi*Q1*L2)*cos(pi*Q2*L1)*cos(pi*Q3*L2)     ! (mlm)
      S3=cos(pi*Q1*L2)*cos(pi*Q2*L2)*cos(pi*Q3*L1)     ! (mml)
      dS=8.0*(S1+S2+S3) ! (lln) (-lln) (l-ln) (ll-n) (-l-ln) (-ll-n) (l-l-n) (-l-l-n)
   elseif(L1/=L2.and.L2/=L3.and.L3/=L1) then !------ 48 (L M N)
      S1=cos(pi*Q1*L1)*cos(pi*Q2*L2)*cos(pi*Q3*L3) + cos(pi*Q1*L1)*cos(pi*Q2*L3)*cos(pi*Q3*L2) ! (lmn) (lnm)
      S2=cos(pi*Q1*L3)*cos(pi*Q2*L1)*cos(pi*Q3*L2) + cos(pi*Q1*L3)*cos(pi*Q2*L2)*cos(pi*Q3*L1) ! (nlm) (nml)
      S3=cos(pi*Q1*L2)*cos(pi*Q2*L3)*cos(pi*Q3*L1) + cos(pi*Q1*L2)*cos(pi*Q2*L1)*cos(pi*Q3*L3) ! (mnl) (mln)
      dS=8.0*(S1+S2+S3) ! (lmn) (-lmn) (l-mn) (lm-n) (-l-mn) (-lm-n) (l-m-n) (-l-m-n)
          end if
       S = S + alp(k)*dS
     end do
     write(*,'(2I6, 4F12.5)') i, j, h1(i,j), h2(i,j), h3(i,j), S
    write(8,'(4F12.5)')            h1(i,j), h2(i,j), h3(i,j), S
   end do
    end do
  close (8)
END PROGRAM Fourie_SRO
!*************************************************************
  SUBROUTINE map_hk (h1, h2, h3, nH, nK, Hs, Ks, He, Ke)
!*************************************************************
    Integer,intent(in)              :: nH, nK
    real,intent(in)                 :: Hs, Ks, He, Ke
 real,dimension(:,:),intent(OUT) :: h1(nH,nK), h2(nH,nK), h3(nH,nK)
 real                            :: dx, dy, x, y, z
 dx=(He-Hs)/(nH-1)
 dy=(Ke-Ks)/(nK-1)
 dx=anint(1000*dx)/1000
 dy=anint(1000*dy)/1000
 x=Hs; y=Ks; z=0.0
 do i=1,nH
   do j=1,nK
  h1(i,j)=x; h2(i,j)=y; h3(i,j)=z
!        write(*,'(2I6, 3F12.5)') i, j, x, y, z
        x=x+dx
  x=anint(1000*x)/1000
   end do
   x=Hs
   y=y+dy
   y=anint(1000*y)/1000
!   read(*,*) aaaaa
 end do
  end subroutine map_hk
!*********************************************************

References

Back to ABE

Back to Department of Materials Science and Engineering

ab@nda.ac.jp

Department of Materials Science and Engineering
National Defense Academy

Last Modified: April 1, 2009