1!
2! Copyright (C) 2002-2005 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!
8!----------------------------------------------------------------------------
9MODULE wannier_base
10  !----------------------------------------------------------------------------
11  !
12  USE kinds, ONLY : DP
13  !
14  IMPLICIT NONE
15  !
16  ! ... input variables
17  !
18  LOGICAL              :: wf_efield
19  LOGICAL              :: wf_switch
20  INTEGER              :: sw_len
21  REAL(DP)             :: efx0, efy0, efz0
22  REAL(DP)             :: efx1, efy1, efz1
23  INTEGER              :: wfsd
24  REAL(DP)             :: wfdt
25!==============================================================
26!exx_wf related
27  INTEGER              :: neigh
28  INTEGER              :: vnbsp
29  REAL(DP)             :: poisson_eps
30  REAL(DP)             :: dis_cutoff
31  REAL(DP)             :: exx_ps_rcut_s
32  REAL(DP)             :: exx_ps_rcut_p
33  REAL(DP)             :: exx_me_rcut_s
34  REAL(DP)             :: exx_me_rcut_p
35  LOGICAL              :: texx_cube
36  !!
37!==============================================================
38  REAL(DP)             :: maxwfdt
39  REAL(DP)             :: wf_q
40  REAL(DP)             :: wf_friction
41  INTEGER              :: nit
42  INTEGER              :: nsd
43  INTEGER              :: nsteps
44  REAL(DP)             :: tolw
45  LOGICAL              :: adapt
46  INTEGER              :: calwf
47  INTEGER              :: nwf
48  INTEGER              :: wffort
49  LOGICAL              :: writev
50  INTEGER, ALLOCATABLE :: iplot(:)
51  !
52  ! ... other internal variables
53  !
54  INTEGER                  :: nw, nwrwf, iwf, jwf
55  INTEGER,     ALLOCATABLE :: wfg1(:), wfg(:,:)
56  INTEGER,     ALLOCATABLE :: indexplus(:,:), indexminus(:,:)
57  INTEGER,     ALLOCATABLE :: indexplusz(:), indexminusz(:)
58  INTEGER,     ALLOCATABLE :: tag(:,:), tagp(:,:)
59  REAL(DP),    ALLOCATABLE :: weight(:)            ! weights of G vectors
60  REAL(DP),    ALLOCATABLE :: gnx(:,:)
61  INTEGER ,    ALLOCATABLE :: gnn(:,:)
62  COMPLEX(DP), ALLOCATABLE :: expo(:,:)
63  !
64  CONTAINS
65    !
66    !------------------------------------------------------------------------
67!=============================================================================
68!exx_wf related
69    SUBROUTINE wannier_init( wf_efield_, wf_switch_, sw_len_, efx0_, efy0_, &
70                             efz0_, efx1_, efy1_, efz1_, wfsd_, wfdt_,      &
71                             neigh_, poisson_eps_ ,dis_cutoff_, exx_ps_rcut_s_, exx_me_rcut_s_,&
72                             exx_ps_rcut_p_, exx_me_rcut_p_, texx_cube_,    &
73                             vnbsp_, maxwfdt_, wf_q_, wf_friction_, nit_, nsd_,     &
74                             nsteps_, tolw_, adapt_, calwf_, nwf_, wffort_, &
75                             writev_, iplot_, restart_mode_ )
76!=============================================================================
77      !------------------------------------------------------------------------
78      !
79      IMPLICIT NONE
80      !
81      LOGICAL,          INTENT(IN) :: wf_efield_
82      LOGICAL,          INTENT(IN) :: wf_switch_
83      INTEGER,          INTENT(IN) :: sw_len_
84      REAL(DP),         INTENT(IN) :: efx0_, efy0_, efz0_
85      REAL(DP),         INTENT(IN) :: efx1_, efy1_, efz1_
86      INTEGER,          INTENT(IN) :: wfsd_
87      REAL(DP),         INTENT(IN) :: wfdt_
88!=============================================================================
89!exx_wf related
90      INTEGER,          INTENT(IN) :: neigh_
91      INTEGER,          INTENT(IN) :: vnbsp_
92      REAL(DP),         INTENT(IN) :: poisson_eps_
93      REAL(DP),         INTENT(IN) :: dis_cutoff_
94      REAL(DP),         INTENT(IN) :: exx_ps_rcut_s_
95      REAL(DP),         INTENT(IN) :: exx_me_rcut_s_
96      REAL(DP),         INTENT(IN) :: exx_ps_rcut_p_
97      REAL(DP),         INTENT(IN) :: exx_me_rcut_p_
98      LOGICAL,          INTENT(IN) :: texx_cube_
99      !!
100!=============================================================================
101      REAL(DP),         INTENT(IN) :: maxwfdt_
102      REAL(DP),         INTENT(IN) :: wf_q_
103      REAL(DP),         INTENT(IN) :: wf_friction_
104      INTEGER,          INTENT(IN) :: nit_
105      INTEGER,          INTENT(IN) :: nsd_
106      INTEGER,          INTENT(IN) :: nsteps_
107      REAL(DP),         INTENT(IN) :: tolw_
108      LOGICAL,          INTENT(IN) :: adapt_
109      INTEGER,          INTENT(IN) :: calwf_
110      INTEGER,          INTENT(IN) :: nwf_
111      INTEGER,          INTENT(IN) :: wffort_
112      INTEGER,          INTENT(IN) :: iplot_(:)
113      LOGICAL,          INTENT(IN) :: writev_
114      CHARACTER(LEN=*), INTENT(IN) :: restart_mode_
115      !
116      !
117      wf_efield   = wf_efield_
118      wf_switch   = wf_switch_
119      sw_len      = sw_len_
120      efx0        = efx0_
121      efy0        = efy0_
122      efz0        = efz0_
123      efx1        = efx1_
124      efy1        = efy1_
125      efz1        = efz1_
126      wfsd        = wfsd_
127      wfdt        = wfdt_
128!==================================================================
129!exx_wf related
130      neigh       = neigh_
131      vnbsp       = vnbsp_
132      poisson_eps = poisson_eps_
133      dis_cutoff  = dis_cutoff_
134      exx_ps_rcut_s = exx_ps_rcut_s_
135      exx_me_rcut_s = exx_me_rcut_s_
136      exx_ps_rcut_p = exx_ps_rcut_p_
137      exx_me_rcut_p = exx_me_rcut_p_
138      texx_cube = texx_cube_
139!==================================================================
140      maxwfdt     = maxwfdt_
141      wf_q        = wf_q_
142      wf_friction = wf_friction_
143      nit         = nit_
144      nsd         = nsd_
145      nsteps      = nsteps_
146      tolw        = tolw_
147      adapt       = adapt_
148      calwf       = calwf_
149      nwf         = nwf_
150      wffort      = wffort_
151      writev      = writev_
152      !
153      IF ( calwf == 1 .AND. nwf == 0 ) &
154         CALL errore( 'wannier_init ', &
155                    & 'when calwf = 1, nwf must be larger that 0', 1 )
156      !
157      IF ( nwf > 0 ) THEN
158         !
159         ALLOCATE( iplot( nwf ) )
160         !
161         iplot(:) = iplot_(1:nwf)
162         !
163      END IF
164      !
165      IF ( TRIM( restart_mode_ ) == "from_scratch" ) THEN
166         !
167         IF ( wf_efield ) &
168            CALL errore( 'wannier_init', 'electric field not ' // &
169                       & 'allowed when starting from scratch', 1 )
170         !
171      END IF
172      !
173    END SUBROUTINE wannier_init
174    !
175    !
176    !
177    SUBROUTINE deallocate_wannier_base()
178       IF( ALLOCATED( iplot ) ) DEALLOCATE( iplot )
179       IF( ALLOCATED( wfg1 ) ) DEALLOCATE( wfg1 )
180       IF( ALLOCATED( wfg ) ) DEALLOCATE( wfg )
181       IF( ALLOCATED( indexplus ) ) DEALLOCATE( indexplus )
182       IF( ALLOCATED( indexminus ) ) DEALLOCATE( indexminus )
183       IF( ALLOCATED( indexplusz ) ) DEALLOCATE( indexplusz )
184       IF( ALLOCATED( indexminusz ) ) DEALLOCATE( indexminusz )
185       IF( ALLOCATED( tag ) ) DEALLOCATE( tag )
186       IF( ALLOCATED( tagp ) ) DEALLOCATE( tagp )
187       IF( ALLOCATED( weight ) ) DEALLOCATE( weight )
188       IF( ALLOCATED( gnx ) ) DEALLOCATE( gnx )
189       IF( ALLOCATED( gnn ) ) DEALLOCATE( gnn )
190       IF( ALLOCATED( expo ) ) DEALLOCATE( expo )
191       RETURN
192    END SUBROUTINE deallocate_wannier_base
193    !
194    !
195    !
196END MODULE wannier_base
197