fzbt.F90

Go to the documentation of this file.

! This file is part of the 'atomes' software.
!
! 'atomes' is free software: you can redistribute it and/or modify it under the terms
! of the GNU Affero General Public License as published by the Free Software Foundation,
! either version 3 of the License, or (at your option) any later version.
!
! 'atomes' is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
! without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
! See the GNU General Public License for more details.
!
! You should have received a copy of the GNU Affero General Public License along with 'atomes'.
! If not, see <https://www.gnu.org/licenses/>
!
! Copyright (C) 2022-2024 by CNRS and University of Strasbourg
!
 
LOGICAL FUNCTION fzbt (NDQ)
 
!
! Compute Faber-Ziman and Bathia-Thornton S(q) from Ashcroft S(q)
!
 
USE parameters
 
IMPLICIT NONE
 
INTEGER, INTENT(IN) :: ndq
DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: xr
 
 
if (nsp .eq. 2) then
  if (allocated(btij)) deallocate(btij)
  allocate(btij(ndq,4), stat=err)
  if (err .ne. 0) then
    call show_error ("Impossible to allocate memory"//char(0), &
                     "Function: FZBT"//char(0), "Table: BTij"//char(0))
    fzbt=.false.
    goto 001
  endif
  btij(:,:)=0.0d0
endif
 
if (allocated(fzsij)) deallocate(fzsij)
allocate(fzsij(ndq,nsp,nsp), stat=err)
if (err .ne. 0) then
  call show_error ("Impossible to allocate memory"//char(0), &
                   "Function: FZBT"//char(0), "Table: FZSij"//char(0))
  fzbt=.false.
  goto 001
endif
 
fzsij(:,:,:)=0.0d0
 
if (allocated(xr)) deallocate(xr)
allocate(xr(nsp), stat=err)
if (err .ne. 0) then
  call show_error ("Impossible to allocate memory"//char(0), &
                   "Function: FZBT"//char(0), "Table: Xr"//char(0))
  fzbt=.false.
  goto 001
endif
 
do o=1, nsp
  xr(o)=xi(o)
enddo
 
do m=1, ndq
  do n=1, nsp
    do o=1, nsp
      if (o .eq. n) then
        fzsij(m,n,o) = 1 + (sij(m,n,o)-1)/xr(n)
        if (nsp .eq. 2) then
          btij(m,1) = btij(m,1) + xr(o)*xr(o)*fzsij(m,n,o)
          btij(m,3) = btij(m,3) + fzsij(m,n,o)
        endif
      else
        fzsij(m,n,o) = sij(m,n,o)/sqrt(xr(n)*xr(o)) + 1
        if (nsp .eq. 2) then
          btij(m,1) = btij(m,1) + xr(o)*xr(n)*fzsij(m,n,o)
          btij(m,3) = btij(m,3) - fzsij(m,n,o)
        endif
      endif
    enddo
  enddo
  if (nsp .eq. 2) then
    if (nbspbs(1) .le. nbspbs(2)) then
      o=1
      n=2
    else
      o=2
      n=1
    endif
    btij(m,2) = xr(o)*fzsij(m,o,o) - xr(n)*fzsij(m,n,n)
    btij(m,2) = btij(m,2)+fzsij(m,o,n)*(xr(n)-xr(o))
    btij(m,2) = btij(m,2)*xr(n)*xr(o)
    btij(m,3) = (btij(m,3)*xr(1)*xr(2) +1)*xr(1)*xr(2)
    btij(m,4) = btij(m,3)/(xr(1)*xr(2))
  endif
enddo
 
if (allocated(xr)) deallocate(xr)
 
fzbt=.true.
 
001 continue
 
END FUNCTION
 
LOGICAL FUNCTION grbt(GrToBT, NDTR)
 
!
! Compute Bathia-Thornton g(r)
!
 
USE parameters
 
INTEGER, INTENT(IN) :: ndtr
DOUBLE PRECISION, DIMENSION(NDTR,NSP,NSP), INTENT(IN) :: grtobt
 
if (allocated(btij)) deallocate(btij)
allocate(btij(ndtr,3), stat=err)
if (err .ne. 0) then
  call show_error ("Impossible to allocate memory"//char(0), &
                   "Function: GRBT"//char(0), "Table: BTij"//char(0))
  grbt=.false.
  goto 001
endif
btij(:,:)=0.0d0
 
do m=1, ndtr
  do n=1, nsp
    do o=1, nsp
      if (o .eq. n) then
        btij(m,1) = btij(m,1) + xi(o)*xi(o)*grtobt(m,n,o)
        btij(m,3) = btij(m,3) + grtobt(m,n,o)
      else
        btij(m,1) = btij(m,1) + xi(o)*xi(n)*grtobt(m,n,o)
        btij(m,3) = btij(m,3) - grtobt(m,n,o)
      endif
    enddo
  enddo
  if (nbspbs(1) .le. nbspbs(2)) then
    o=1
    n=2
  else
    o=2
    n=1
  endif
  btij(m,2) = xi(o)*grtobt(m,o,o) - xi(n)*grtobt(m,n,n)
  btij(m,2) = btij(m,2)+grtobt(m,o,n)*(xi(n)-xi(o))
  btij(m,3) = btij(m,3)*xi(1)*xi(2)
!  BTij(m,4) = BTij(m,3)/(Xi(1)*Xi(2))
!  BTij(m,5) = BTij(m,2)/(Xi(n)/ )
enddo
 
grbt=.true.
 
001 continue
 
END FUNCTION