1!
2! Copyright (C) 2002-2007 Quantum ESPRESSO group
3! This file is distributed under the terms of the
4! GNU General Public License. See the file `License'
5! in the root directory of the present distribution,
6! or http://www.gnu.org/copyleft/gpl.txt .
7!
8module local_pseudo
9  use kinds, only: DP
10  implicit none
11  save
12  !
13  !    rhops = ionic pseudocharges (for Ewald term)
14  !    vps   = local pseudopotential in G space for each species
15  !
16  real(DP), allocatable:: rhops(:,:), vps(:,:)
17  !
18  !    drhops = derivative of rhops respect to G^2
19  !    dvps   = derivative of vps respect to G^2
20  !
21  real(DP),allocatable:: dvps(:,:), drhops(:,:)
22  !
23  !    vps0  = correction factors needed to align V(0) to the "traditional"
24  !            value used by other plane-wave codes - one per species
25  !
26  real(DP),allocatable:: vps0(:)
27  !
28contains
29  !
30  subroutine allocate_local_pseudo( ng, nsp )
31      integer, intent(in) :: ng, nsp
32      call deallocate_local_pseudo()
33      ALLOCATE( rhops( ng, nsp ) )
34      ALLOCATE( vps( ng, nsp ) )
35      ALLOCATE( drhops( ng, nsp ) )
36      ALLOCATE( dvps( ng, nsp ) )
37      ALLOCATE( vps0( nsp ) )
38  end subroutine
39  !
40  subroutine deallocate_local_pseudo
41      IF( ALLOCATED( vps0 ) ) DEALLOCATE( vps0 )
42      IF( ALLOCATED( dvps ) ) DEALLOCATE( dvps )
43      IF( ALLOCATED( drhops ) ) DEALLOCATE( drhops )
44      IF( ALLOCATED( vps ) ) DEALLOCATE( vps )
45      IF( ALLOCATED( rhops ) ) DEALLOCATE( rhops )
46  end subroutine
47  !
48end module local_pseudo
49
50module qgb_mod
51  USE kinds, ONLY: DP
52  implicit none
53  save
54  complex(DP), allocatable :: qgb(:,:,:)
55  complex(DP), allocatable :: dqgb(:,:,:,:,:)
56contains
57  subroutine deallocate_qgb_mod
58      IF( ALLOCATED( qgb ) ) DEALLOCATE( qgb )
59      IF( ALLOCATED( dqgb ) ) DEALLOCATE( dqgb )
60  end subroutine deallocate_qgb_mod
61end module qgb_mod
62
63
64MODULE metagga_cp  !metagga
65  USE kinds, ONLY: DP
66  implicit none
67  !the variables needed for meta-GGA
68  REAL(DP), ALLOCATABLE :: &
69       kedtaus(:,:), &! KineticEnergyDensity in real space,smooth grid
70       kedtaur(:,:), &! real space, density grid
71       crosstaus(:,:,:), &!used by stress tensor,in smooth grid
72       dkedtaus(:,:,:,:)  !derivative of kedtau wrt h on smooth grid
73  COMPLEX(DP) , ALLOCATABLE :: &
74       kedtaug(:,:),    & !KineticEnergyDensity in G space
75       gradwfc(:,:)    !used by stress tensor
76contains
77  subroutine deallocate_metagga
78      IF( ALLOCATED(crosstaus))DEALLOCATE(crosstaus)
79      IF( ALLOCATED(dkedtaus)) DEALLOCATE(dkedtaus)
80      IF( ALLOCATED(gradwfc))  DEALLOCATE(gradwfc)
81  end subroutine deallocate_metagga
82END MODULE metagga_cp  !end metagga
83
84MODULE dener
85  USE kinds, ONLY: DP
86  IMPLICIT NONE
87  SAVE
88  REAL(DP) :: dekin(3,3)
89  REAL(DP) :: dh(3,3)
90  REAL(DP) :: dps(3,3)
91  REAL(DP) :: denl(3,3)
92  REAL(DP) :: dxc(3,3)
93  REAL(DP) :: dsr(3,3)
94  REAL(DP) :: detot(3,3)
95  REAL(DP) :: denlc(3,3)
96  REAL(DP) :: dekin6(6)
97  REAL(DP) :: dh6(6)
98  REAL(DP) :: dps6(6)
99  REAL(DP) :: denl6(6)
100  REAL(DP) :: dxc6(6)
101  REAL(DP) :: dsr6(6)
102  REAL(DP) :: detot6(6)
103END MODULE dener
104
105
106
107
108MODULE stress_param
109
110   USE kinds, ONLY : DP
111
112   IMPLICIT NONE
113   SAVE
114
115   INTEGER, DIMENSION(6), PARAMETER :: alpha = (/ 1,2,3,2,3,3 /)
116   INTEGER, DIMENSION(6), PARAMETER :: beta  = (/ 1,1,1,2,2,3 /)
117
118   REAL(DP),  DIMENSION(3,3), PARAMETER :: delta = reshape &
119         ( (/ 1.0_DP, 0.0_DP, 0.0_DP, &
120              0.0_DP, 1.0_DP, 0.0_DP, &
121              0.0_DP, 0.0_DP, 1.0_DP  &
122            /), (/ 3, 3 /) )
123
124   ! ...  dalbe(:) = delta(alpha(:),beta(:))
125   !
126   REAL(DP),  DIMENSION(6), PARAMETER :: dalbe = &
127         (/ 1.0_DP, 0.0_DP, 0.0_DP, 1.0_DP, 0.0_DP, 1.0_DP /)
128
129END MODULE
130
131
132
133MODULE core
134   !
135   USE kinds
136   USE uspp, ONLY : nlcc_any
137   !
138   IMPLICIT NONE
139   SAVE
140   !     rhocb  = core charge in G space (box grid)
141   !     rhoc   = core charge in real space  (dense grid)
142   !     rhocg  = core charge in G space  (dense grid)
143   !     drhocg = derivative of core charge in G space (used for stress)
144   !
145   REAL(DP), ALLOCATABLE:: rhocb(:,:)
146   REAL(DP), ALLOCATABLE:: rhoc(:)
147   REAL(DP), ALLOCATABLE:: rhocg(:,:)
148   REAL(DP), ALLOCATABLE:: drhocg(:,:)
149   !
150CONTAINS
151   !
152   SUBROUTINE allocate_core( nrxx, ngm, ngb, nsp )
153     INTEGER, INTENT(IN) :: nrxx, ngm, ngb, nsp
154     IF ( nlcc_any ) THEN
155        !
156        ALLOCATE( rhoc( nrxx ) )
157        ALLOCATE( rhocb( ngb, nsp ) )
158        ALLOCATE( rhocg( ngm, nsp ) )
159        ALLOCATE( drhocg( ngm, nsp ) )
160        !
161     ELSE
162        !
163        ! ... dummy allocation required because this array appears in the
164        ! ... list of arguments of some routines
165        !
166        ALLOCATE( rhoc( 1 ) )
167        !
168     END IF
169   END SUBROUTINE allocate_core
170   !
171   SUBROUTINE deallocate_core()
172      IF( ALLOCATED( rhocb  ) ) DEALLOCATE( rhocb )
173      IF( ALLOCATED( rhoc   ) ) DEALLOCATE( rhoc  )
174      IF( ALLOCATED( rhocg  ) ) DEALLOCATE( rhocg  )
175      IF( ALLOCATED( drhocg ) ) DEALLOCATE( drhocg )
176   END SUBROUTINE deallocate_core
177   !
178END MODULE core
179!
180