mirror of https://gitlab.com/QEF/q-e.git
153 lines
4.8 KiB
Fortran
153 lines
4.8 KiB
Fortran
!
|
|
! Copyright (C) 2002-2011 Quantum ESPRESSO group
|
|
! This file is distributed under the terms of the
|
|
! GNU General Public License. See the file `License'
|
|
! in the root directory of the present distribution,
|
|
! or http://www.gnu.org/copyleft/gpl.txt .
|
|
!
|
|
!------------------------------------------------------------------------------!
|
|
MODULE cell_nose
|
|
!------------------------------------------------------------------------------!
|
|
!! Thermostat (Nose) variables and routines.
|
|
|
|
USE kinds, ONLY : DP
|
|
!
|
|
IMPLICIT NONE
|
|
SAVE
|
|
|
|
REAL(DP) :: xnhh0(3,3) = 0.0_DP
|
|
REAL(DP) :: xnhhm(3,3) = 0.0_DP
|
|
REAL(DP) :: xnhhp(3,3) = 0.0_DP
|
|
REAL(DP) :: vnhh(3,3) = 0.0_DP
|
|
REAL(DP) :: temph = 0.0_DP
|
|
!! Thermostat temperature (from input)
|
|
REAL(DP) :: fnoseh = 0.0_DP
|
|
!! Thermostat frequency (from input)
|
|
REAL(DP) :: qnh = 0.0_DP
|
|
!! Thermostat mass (computed)
|
|
REAL(DP) :: cell_nose_energy
|
|
!! variable to hold the last computed thermostat's energy
|
|
|
|
CONTAINS
|
|
|
|
subroutine cell_nose_init( temph_init, fnoseh_init )
|
|
!! Set thermostat parameter for cell.
|
|
USE constants, ONLY: pi, au_terahertz, k_boltzmann_au
|
|
REAL(DP), INTENT(IN) :: temph_init, fnoseh_init
|
|
qnh = 0.0_DP
|
|
temph = temph_init
|
|
fnoseh = fnoseh_init
|
|
if( fnoseh > 0.0_DP ) qnh = 2.0_DP * ( 3 * 3 ) * temph * k_boltzmann_au / &
|
|
(fnoseh*(2.0_DP*pi)*au_terahertz)**2
|
|
return
|
|
end subroutine cell_nose_init
|
|
|
|
subroutine cell_nosezero( vnhh, xnhh0, xnhhm )
|
|
!! Set to zero Nose variables
|
|
real(DP), intent(out) :: vnhh(3,3), xnhh0(3,3), xnhhm(3,3)
|
|
xnhh0=0.0_DP
|
|
xnhhm=0.0_DP
|
|
vnhh =0.0_DP
|
|
return
|
|
end subroutine cell_nosezero
|
|
|
|
subroutine cell_nosevel( vnhh, xnhh0, xnhhm, delt )
|
|
!! Calculates Nose velocities.
|
|
implicit none
|
|
REAL(DP), intent(inout) :: vnhh(3,3)
|
|
REAL(DP), intent(in) :: xnhh0(3,3), xnhhm(3,3), delt
|
|
vnhh(:,:)=2.0_DP*(xnhh0(:,:)-xnhhm(:,:))/delt-vnhh(:,:)
|
|
return
|
|
end subroutine cell_nosevel
|
|
|
|
subroutine cell_noseupd( xnhhp, xnhh0, xnhhm, delt, qnh, temphh, temph, vnhh )
|
|
!! Update Nose variables.
|
|
use constants, only: k_boltzmann_au
|
|
implicit none
|
|
REAL(DP), intent(out) :: xnhhp(3,3), vnhh(3,3)
|
|
REAL(DP), intent(in) :: xnhh0(3,3), xnhhm(3,3), delt, qnh, temphh(3,3), temph
|
|
integer :: i, j
|
|
do j=1,3
|
|
do i=1,3
|
|
xnhhp(i,j) = 2.0_DP*xnhh0(i,j)-xnhhm(i,j) + &
|
|
(delt**2/qnh)* k_boltzmann_au * (temphh(i,j)-temph)
|
|
vnhh(i,j) =(xnhhp(i,j)-xnhhm(i,j))/( 2.0_DP * delt )
|
|
end do
|
|
end do
|
|
return
|
|
end subroutine cell_noseupd
|
|
|
|
|
|
REAL(DP) function cell_nose_nrg( qnh, xnhh0, vnhh, temph, iforceh )
|
|
!! Calculate Nose energy.
|
|
use constants, only: k_boltzmann_au
|
|
implicit none
|
|
REAL(DP) :: qnh, vnhh( 3, 3 ), temph, xnhh0( 3, 3 )
|
|
integer :: iforceh( 3, 3 )
|
|
integer :: i, j
|
|
REAL(DP) :: enij
|
|
cell_nose_nrg = 0.0_DP
|
|
do i=1,3
|
|
do j=1,3
|
|
enij = 0.5_DP*qnh*vnhh(i,j)*vnhh(i,j)+temph*k_boltzmann_au*xnhh0(i,j)
|
|
cell_nose_nrg = cell_nose_nrg + iforceh( i, j ) * enij
|
|
enddo
|
|
enddo
|
|
return
|
|
end function cell_nose_nrg
|
|
|
|
subroutine cell_nose_shiftvar( xnhhp, xnhh0, xnhhm )
|
|
!! Shift values of Nose variables to start a new step.
|
|
implicit none
|
|
REAL(DP), intent(out) :: xnhhm(3,3)
|
|
REAL(DP), intent(inout) :: xnhh0(3,3)
|
|
REAL(DP), intent(in) :: xnhhp(3,3)
|
|
xnhhm = xnhh0
|
|
xnhh0 = xnhhp
|
|
return
|
|
end subroutine cell_nose_shiftvar
|
|
|
|
|
|
SUBROUTINE cell_nose_info ( delt )
|
|
!! Print Nose thermostat infos (mass, frequency, time steps).
|
|
use constants, only: au_terahertz, pi
|
|
USE io_global, ONLY: stdout
|
|
USE control_flags, ONLY: tnoseh
|
|
|
|
IMPLICIT NONE
|
|
|
|
REAL(DP), INTENT (IN) :: delt
|
|
|
|
INTEGER :: nsvar
|
|
REAL(DP) :: wnoseh
|
|
|
|
IF( tnoseh ) THEN
|
|
!
|
|
IF( fnoseh <= 0.0_DP) &
|
|
CALL errore(' cell_nose_info ', ' fnoseh less than zero ', 1)
|
|
IF( delt <= 0.0_DP) &
|
|
CALL errore(' cell_nose_info ', ' delt less than zero ', 1)
|
|
|
|
wnoseh = fnoseh * ( 2.0_DP * pi ) * au_terahertz
|
|
nsvar = ( 2.0_DP * pi ) / ( wnoseh * delt )
|
|
|
|
WRITE( stdout,563) temph, nsvar, fnoseh, qnh
|
|
END IF
|
|
|
|
563 format( //, &
|
|
& 3X,'cell dynamics with Nose` temperature control:', /, &
|
|
& 3X,'Kinetic energy required = ', f10.5, ' (Kelvin) ', /, &
|
|
& 3X,'time steps per Nose osc. = ', i5, /, &
|
|
& 3X,'nose` frequency = ', f10.3, ' (THz) ', /, &
|
|
& 3X,'nose` mass(es) = ', 20(1X,f10.3),//)
|
|
|
|
RETURN
|
|
END SUBROUTINE cell_nose_info
|
|
|
|
|
|
!
|
|
!------------------------------------------------------------------------------!
|
|
END MODULE cell_nose
|
|
!------------------------------------------------------------------------------!
|
|
|