1MODULE paw_variables
2    !
3    USE kinds,      ONLY : DP
4    !
5    IMPLICIT NONE
6    PUBLIC
7    SAVE
8
9    !!!!!!!!!!!!!!!!!!!!!!!!
10    !!!! Control flags: !!!!
11
12    ! Set to true after initialization, to prevent double allocs:
13    LOGICAL              :: paw_is_init = .false.
14    ! Analogous to okvan in  "uspp_param" (Modules/uspp.f90)
15    LOGICAL :: &
16         okpaw = .FALSE.          ! if .TRUE. at least one pseudo is PAW
17
18    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
19    !!!! Pseudopotential data: !!!!
20
21    ! There is (almost) no pseudopotential data here, it is all stored in the upf type.
22    ! See files pseudo_types.f90 and read_uspp.f90
23
24    ! Constant to be added to etot to get all-electron energy
25    REAL(DP) :: total_core_energy = 0._dp
26    ! true if all the pseudopotentials are PAW
27    LOGICAL  :: only_paw
28
29    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
30    !!!! Initialization data: !!!!
31
32    INTEGER,PARAMETER    :: lm_fact = 3   ! To converge E_xc integrate up to LM = lm_fact * lm_max
33    INTEGER,PARAMETER    :: lm_fact_x = 3 ! As above, for gradient corrected functionals
34    INTEGER,PARAMETER    :: xlm = 2       ! Additional factor to add to have a good grad.corr.
35    INTEGER,PARAMETER    :: radial_grad_style = 0 ! = 0 or 1, algorithm to use for d/dr
36
37    TYPE paw_radial_integrator
38        ! the following variables are used to integrate radial sampling
39        INTEGER          :: lmax        ! max l component that can be integrated correctly
40        INTEGER          :: ladd        ! additional l max that have been added for grad.corr.
41        INTEGER          :: lm_max      ! as above, but +1 and squared
42        INTEGER          :: nx          ! number of integration directions
43        REAL(DP),POINTER :: ww(:)       ! integration weights (one per direction)
44        REAL(DP),POINTER :: ylm(:,:)    ! Y_lm(nx,lm_max)
45        REAL(DP),POINTER :: wwylm(:,:)  ! ww(nx) * Y_lm(nx,lm_max)
46        ! additional variables for gradient correction
47        REAL(DP),POINTER :: dylmt(:,:),&! |d(ylm)/dtheta|**2
48                            dylmp(:,:)  ! |d(ylm)/dphi|**2
49        REAL(DP),POINTER :: cos_phi(:)  ! cos(phi)
50        REAL(DP),POINTER :: sin_phi(:)  ! sin(phi)
51        REAL(DP),POINTER :: cos_th(:)  ! cos(theta)  (for divergence)
52        REAL(DP),POINTER :: sin_th(:)  ! sin(theta)  (for divergence)
53        REAL(DP),POINTER :: cotg_th(:)  ! cos(theta)/sin(theta)  (for divergence)
54    END TYPE
55    TYPE(paw_radial_integrator), ALLOCATABLE :: &
56        rad(:) ! information to integrate different atomic species
57
58    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
59    !!!! self-consistent variables: !!!!
60
61    ! This type contains some useful data that has to be passed to all
62    ! functions, but cannot stay in global variables for parallel:
63    TYPE paw_info
64        INTEGER :: a ! atom index
65        INTEGER :: t ! atom type index = itype(a)
66        INTEGER :: m ! atom mesh = g(t)%mesh
67        INTEGER :: b ! number of beta functions = upf(t)%nbeta
68        INTEGER :: l ! max angular index l+1 -> (l+1)**2 is max
69                     ! lm index, it is used to allocate rho
70        INTEGER :: ae ! tells if we are doing all-electron (1) or pseudo (2)
71    END TYPE
72
73    ! Analogous to deeq in "uspp_param" (Modules/uspp.f90)
74    REAL(DP), ALLOCATABLE :: &
75         ddd_paw(:,:,:)  ! D: D^1_{ij} - \tilde{D}^1_{ij} (only Hxc part)
76
77    REAL(DP), ALLOCATABLE ::  vs_rad(:,:,:)
78
79 END MODULE paw_variables
80