scnc
/
quantum-espresso
mirror of https://gitlab.com/QEF/q-e.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Ford-modules part 4

This commit is contained in:
fabrizio22 2021-02-23 22:37:52 +01:00
parent ba0f0ce89e
commit 89fcba7680
4 changed files with 103 additions and 76 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
Modules/set_signal.f90
View File

@ -1,11 +1,13 @@
MODULE set_signal
! This module is a Fortran 2003 interface to the customize_signals.c C file
! Compatible with Intel/PGI/Gcc(>=4.3) compilers
! This module is compiled only if the following preprocessing option
! is enabled
!
#if defined(__TRAP_SIGUSR1) || defined(__TERMINATE_GRACEFULLY)
!
MODULE set_signal
!! This module is a Fortran 2003 interface to the customize_signals.c C file
!! Compatible with Intel/PGI/Gcc(>=4.3) compilers
!
! This module is compiled only if the upper preprocessing option
! is enabled
!
USE iso_c_binding
USE io_global, ONLY : stdout
USE mp_world, ONLY : root, world_comm, mpime
@ -159,8 +161,12 @@ FUNCTION signal_detected()
END FUNCTION signal_detected
END MODULE
#else
MODULE set_signal
USE io_global, ONLY : stdout
CONTAINS
@ -175,7 +181,7 @@ FUNCTION signal_detected()
LOGICAL::signal_detected
signal_detected = .FALSE.
END FUNCTION signal_detected
#endif
END MODULE set_signal
#endif

10
Modules/volume.f90
View File

@ -9,11 +9,11 @@
!---------------------------------------------------------------------
SUBROUTINE volume (alat, a1, a2, a3, omega)
!---------------------------------------------------------------------
!
! Compute the volume of the unit cell defined by 3 vectors
! a1, a2, a3, given in units of "alat" (alat may be 1):
! omega = alat^3 * [ a1 . (a2 x a3) ]
! ( . = scalar product, x = vector product )
!! Compute the volume of the unit cell defined by 3 vectors
!! \({\bf a}_1, {\bf a}_2, {\bf a}_3 \), given in units of "alat"
!! (alat may be 1):
!! $$ \text{omega} = \text{alat}^3 [ {\bf a}_1 \cdot ({\bf a}_2 \times
!! {\bf a}_3) ] $$
!
USE kinds, ONLY: dp
IMPLICIT NONE

31
Modules/wgauss.f90
View File

@ -9,30 +9,29 @@
!-----------------------------------------------------------------------
function wgauss (x, n)
!-----------------------------------------------------------------------
!! This function computes the approximate theta function for the
!! given order n, at the point x:
!
! this function computes the approximate theta function for the
! given order n, at the point x.
!
! --> (n>=0) : Methfessel-Paxton case. See PRB 40, 3616 (1989).
!
! --> (n=-1 ): Cold smearing (Marzari-Vanderbilt-DeVita-Payne).
! See PRL 82, 3296 (1999)
! 1/2*erf(x-1/sqrt(2)) + 1/sqrt(2*pi)*exp(-(x-1/sqrt(2))**2) + 1/2
!
! --> (n=-99): Fermi-Dirac case: 1.0/(1.0+exp(-x)).
!! * \( n \geq 0 \): Methfessel-Paxton case. See PRB 40, 3616 (1989).
!! * \( n=-1 \): cold smearing (Marzari-Vanderbilt-DeVita-Payne,
!! see PRL 82, 3296 (1999)):
!! $$ \frac{1}{2} \text{erf}\(x-\frac{1}{\sqrt(2)}\) + \frac{1}{\sqrt{2\pi}} \exp
!! {-\(x-\frac{1}{sqrt{2}}\)^2} + 1/2 $$
!! * \( n=-99 \): Fermi-Dirac case:
!! $$ \frac{1.0}{1.0+\exp{-x}} $$
!
USE kinds, ONLY : DP
USE constants, ONLY : pi
implicit none
real(DP) :: wgauss, x
! output: the value of the function
! input: the argument of the function
real(DP) :: wgauss
!! output: the value of the function
real(DP) :: x
!! input: the argument of the function
integer :: n
! input: the order of the function
!! input: the order of the function
!
! the local variables
! ... local variables
!
real(DP) :: a, hp, arg, hd, xp
! the coefficient a_n
! the hermitean function

114
Modules/ws_base.f90
View File

@ -7,14 +7,13 @@
!
MODULE ws_base
!============================================================================
!! Module containing type definitions and auxiliary routines to deal with
!! basic operations on the Wigner-Seitz cell associated to a given set
!! of Bravais fundamental lattice vectors.
!
! Module containing type definitions and auxiliary routines to deal with
! basic operations on the Wigner-Seitz cell associated to a given set
! of Bravais fundamental lattice vectors.
!
! Should contain low level routines and no reference to other modules
! (with the possible exception of kinds and parameters) so as to be
! call-able from any other module.
! It should contain low level routines and no reference to other modules
! (with the possible exception of kinds and parameters) so as to be
! call-able from any other module.
!
! content:
!
@ -50,34 +49,39 @@ MODULE ws_base
!
!============================================================================
!
USE kinds, ONLY: dp
USE kinds, ONLY: DP
!
IMPLICIT NONE
!
TYPE ws_type
!! derived type definition used to encode the auxiliary
!! quantities needed by the other WS functions or routines.
PRIVATE ! this means (I hope) that internal variables can only
! be accessed through calls of routines inside the module.
REAL(DP) :: &
a(3,3), & ! the fundamental Bravais lattice vectors
aa(3,3), & ! a^T*a
b(3,3), & ! the inverse of a, i.e. the transponse of the fundamental
! reciprocal lattice vectors
norm_b(3) ! the norm of the fundamental reciprocal lattice vectors
LOGICAL :: &
initialized = .FALSE. ! .TRUE. when initialized
REAL(DP) :: a(3,3)
!! the fundamental Bravais lattice vectors
REAL(DP) :: aa(3,3)
!! a^T*a
REAL(DP) :: b(3,3)
!! the inverse of a, i.e. the transponse of the fundamental
!! reciprocal lattice vectors
REAL(DP) :: norm_b(3)
!! the norm of the fundamental reciprocal lattice vectors
LOGICAL :: initialized = .FALSE.
!! .TRUE. when initialized
END TYPE ws_type
!
PRIVATE
PUBLIC :: ws_type, ws_init, ws_clean, ws_test, ws_vect, ws_dist, ws_weight, ws_dist_stupid
!
!============================================================================
!
CONTAINS
!---------------------------------------------------------------
!---------------------------------------------------------------
SUBROUTINE ws_init(a,ws)
!---------------------------------------------------------------
!---------------------------------------------------------------
!! Initializes a \texttt{ws\_type} variable.
!
USE matrix_inversion
REAL(DP), INTENT(IN) :: a(3,3)
TYPE(ws_type), INTENT(OUT) :: ws
@ -92,32 +96,38 @@ MODULE ws_base
ws%initialized = .TRUE.
RETURN
END SUBROUTINE ws_init
!
!---------------------------------------------------------------
END SUBROUTINE ws_init
!
!---------------------------------------------------------------
SUBROUTINE ws_clean(ws)
!---------------------------------------------------------------
!---------------------------------------------------------------
!! Un-sets a \texttt{ws\_type} variable.
!
TYPE(ws_type), INTENT(OUT) :: ws
!
ws%initialized = .FALSE.
!
RETURN
END SUBROUTINE ws_clean
!
!---------------------------------------------------------------
!
!---------------------------------------------------------------
SUBROUTINE ws_test(ws)
!---------------------------------------------------------------
!---------------------------------------------------------------
!! Tests whether a ws_type variable has been initialized.
!
TYPE(ws_type), INTENT(IN) :: ws
!
IF (.NOT.ws%initialized) CALL errore &
('ws_test','trying to use an uninitialized ws_type variable',1)
!
RETURN
END SUBROUTINE ws_test
!---------------------------------------------------------------
!
!---------------------------------------------------------------
SUBROUTINE ws_vect(r,ws,r_ws)
!---------------------------------------------------------------
!---------------------------------------------------------------
!! Given a vector returns an equivalent vector inside the WS cell.
!
REAL(DP), INTENT(IN) :: r(3)
TYPE(ws_type), INTENT(IN) :: ws
REAL(DP), INTENT(OUT) :: r_ws(3)
@ -154,10 +164,11 @@ MODULE ws_base
RETURN
END SUBROUTINE ws_vect
!
!---------------------------------------------------------------
!
!---------------------------------------------------------------
FUNCTION ws_dist_stupid(r,ws)
!---------------------------------------------------------------
!---------------------------------------------------------------
!
REAL(DP), INTENT(IN) :: r(3)
TYPE(ws_type), INTENT(IN) :: ws
REAL(DP) :: ws_dist_stupid
@ -183,11 +194,14 @@ MODULE ws_base
ws_dist_stupid = DSQRT(rmin)
RETURN
END FUNCTION ws_dist_stupid
!
!---------------------------------------------------------------
END FUNCTION ws_dist_stupid
!
!---------------------------------------------------------------
FUNCTION ws_dist(r,ws)
!---------------------------------------------------------------
!---------------------------------------------------------------
!! Given a vector, returns the shortest distance from any point
!! in the Bravais lattice.
!
REAL(DP), INTENT(IN) :: r(3)
TYPE(ws_type), INTENT(IN) :: ws
REAL(DP) :: ws_dist
@ -201,10 +215,18 @@ MODULE ws_base
RETURN
END FUNCTION ws_dist
!
!---------------------------------------------------------------
!
!---------------------------------------------------------------
FUNCTION ws_weight(r,ws)
!---------------------------------------------------------------
!---------------------------------------------------------------
!! Given a vector, it returns:
!
!! * 1.0 if the vector is inside the WS cell;
!! * 0.0 if the vector is outside the WS cell;
!! * 1/(1+NR) if the vector is on the frontier of the WS cell
!! and NR is the number of Bravais lattice points whose
!! distance is the same as the one from the origin.
!
REAL(DP), INTENT(IN) :: r(3)
TYPE(ws_type), INTENT(IN) :: ws
REAL(DP) :: ws_weight