1!
2! Copyright (C) 2002-2016 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 control_flags
10  !=--------------------------------------------------------------------------=!
11  !
12  ! ... this module contains all basic variables that controls the
13  ! ... execution flow
14  !----------------------------------------------
15  !
16  USE kinds
17  USE parameters
18  !
19  IMPLICIT NONE
20  !
21  SAVE
22  !
23  PRIVATE
24  !
25  TYPE convergence_criteria
26     !
27     LOGICAL  :: active
28     INTEGER  :: nstep
29     REAL(DP) :: ekin
30     REAL(DP) :: derho
31     REAL(DP) :: force
32     !
33  END TYPE convergence_criteria
34  !
35  PUBLIC :: tbeg, nomore, nbeg, isave, iprint, tv0rd, tzeroc, tzerop,        &
36            tfor, tpre, tzeroe, tsde, tsdp, tsdc, taurdr,                    &
37            ndr, ndw, tortho, ortho_eps, ortho_max, tstress, tprnfor,        &
38            timing, memchk, trane, dt_old, ampre, tranp, amprp,              &
39            tnosee, tnosep, tnoseh, tcp, tcap,                               &
40            tconvthrs, tolp, convergence_criteria, tionstep, nstepe,         &
41            tscreen, gamma_only, force_pairing, lecrpa, tddfpt, smallmem,    &
42            tfirst, tlast, tprint, trescalee, max_xml_steps, dfpt_hub
43  !
44  PUBLIC :: fix_dependencies, check_flags
45  PUBLIC :: tksw, trhor, thdyn, trhow
46  !
47  ! ...   declare execution control variables
48  !
49  LOGICAL :: trhor     = .FALSE. ! read rho from unit 47 (only cp, seldom used)
50  LOGICAL :: trhow     = .FALSE. ! CP code, write rho to restart dir
51  LOGICAL :: tksw      = .FALSE. ! CP: write Kohn-Sham states to restart dir
52  LOGICAL :: tfirst    = .TRUE.  ! CP: true if first iteration after restart
53  LOGICAL :: tlast     = .FALSE. ! CP: true if last iteration before ending
54  LOGICAL :: tprint    = .FALSE. ! CP: set to true when calculation of time
55                                 !     derivatives of wave functions must be
56                                 !     computed via projection on occupied
57                                 !     manifold
58  !
59  LOGICAL :: tsde          = .FALSE. ! electronic steepest descent
60  LOGICAL :: tzeroe        = .FALSE. ! set to zero the electronic velocities
61  LOGICAL :: trescalee     = .FALSE. ! rescale the electronics velocities
62  LOGICAL :: tfor          = .FALSE. ! move the ions ( calculate forces )
63  LOGICAL :: tsdp          = .FALSE. ! ionic steepest descent
64  LOGICAL :: tzerop        = .FALSE. ! set to zero the ionic velocities
65  LOGICAL :: tprnfor       = .FALSE. ! print forces to standard output
66  LOGICAL :: taurdr        = .FALSE. ! read ionic position from standard input
67  LOGICAL :: tv0rd         = .FALSE. ! read ionic velocities from standard input
68  LOGICAL :: tpre          = .FALSE. ! calculate stress, and (in fpmd) variable cell dynamic
69  LOGICAL :: thdyn         = .FALSE. ! variable-cell dynamics (only cp)
70  LOGICAL :: tsdc          = .FALSE. ! cell geometry steepest descent
71  LOGICAL :: tzeroc        = .FALSE. ! set to zero the cell geometry velocities
72  LOGICAL :: tstress       = .FALSE. ! print stress to standard output
73  LOGICAL :: tortho        = .FALSE. ! use iterative orthogonalization
74  LOGICAL :: timing        = .FALSE. ! print out timing information
75  LOGICAL :: memchk        = .FALSE. ! check for memory leakage
76  LOGICAL :: tscreen       = .FALSE. ! Use screened coulomb potentials for cluster calculations
77  LOGICAL :: force_pairing = .FALSE. ! Force pairing
78  LOGICAL :: lecrpa        = .FALSE. ! RPA correlation energy request
79  LOGICAL :: dfpt_hub      = .FALSE. ! If .true. perform the SCF calculation of U (and V)
80                                     ! and let PW rotuines to know about this
81  LOGICAL :: tddfpt        = .FALSE. ! use TDDFPT specific tweaks when using the Environ plugin
82  LOGICAL :: smallmem      = .FALSE. ! the memory per task is small
83  !
84  TYPE (convergence_criteria) :: tconvthrs
85                              !  thresholds used to check GS convergence
86  !
87  ! ... Ionic vs Electronic step frequency
88  ! ... When "ion_nstep > 1" and "electron_dynamics = 'md' | 'sd' ", ions are
89  ! ... propagated every "ion_nstep" electronic step only if the electronic
90  ! ... "ekin" is lower than "ekin_conv_thr"
91  !
92  LOGICAL :: tionstep = .FALSE.
93  INTEGER :: nstepe   = 1
94                            !  parameters to control how many electronic steps
95                            !  between ions move
96
97  INTEGER :: nbeg   = 0 ! internal code for initialization ( -1, 0, 1, 2, .. )
98  INTEGER :: ndw    = 0 !
99  INTEGER :: ndr    = 0 !
100  INTEGER :: nomore = 0 !
101  INTEGER :: iprint =10 ! print output every iprint step
102  INTEGER  :: max_xml_steps =0 ! max number of dynamics included in xml file if 0 all steps are included.
103  INTEGER :: isave  = 0 ! write restart to ndr unit every isave step
104  !
105  ! ... .TRUE. if only gamma point is used
106  !
107  LOGICAL :: gamma_only = .TRUE.
108  !
109  ! This variable is used whenever a timestep change is requested
110  !
111  REAL(DP) :: dt_old = -1.0_DP
112  !
113  ! ... Wave function randomization
114  !
115  LOGICAL  :: trane = .FALSE.
116  REAL(DP) :: ampre = 0.0_DP
117  !
118  ! ... Ionic position randomization
119  !
120  LOGICAL  :: tranp(nsx) = .FALSE.
121  REAL(DP) :: amprp(nsx) = 0.0_DP
122  !
123  ! ... Read the cell from standard input
124  !
125  LOGICAL :: tbeg = .FALSE.
126  !
127  ! ... Flag controlling the Nose thermostat for electrons
128  !
129  LOGICAL :: tnosee = .FALSE.
130  !
131  ! ... Flag controlling the Nose thermostat for the cell
132  !
133  LOGICAL :: tnoseh = .FALSE.
134  !
135  ! ... Flag controlling the Nose thermostat for ions
136  !
137  LOGICAL  :: tnosep = .FALSE.
138  LOGICAL  :: tcap   = .FALSE.
139  LOGICAL  :: tcp    = .FALSE.
140  REAL(DP) :: tolp   = 0.0_DP   !  tolerance for temperature variation
141  !
142  REAL(DP), PUBLIC :: &
143       ekin_conv_thr = 0.0_DP, &!  conv. threshold for fictitious e. kinetic energy
144       etot_conv_thr = 0.0_DP, &!  conv. threshold for DFT energy
145       forc_conv_thr = 0.0_DP   !  conv. threshold for atomic forces
146  INTEGER, PUBLIC :: &
147       ekin_maxiter = 100,   &!  max number of iter. for ekin convergence
148       etot_maxiter = 100,   &!  max number of iter. for etot convergence
149       forc_maxiter = 100     !  max number of iter. for atomic forces conv.
150  !
151  ! ... Several variables controlling the run ( used mainly in PW calculations )
152  !
153  ! ... logical flags controlling the execution
154  !
155  LOGICAL, PUBLIC :: &
156    lscf    =.FALSE., &! if .TRUE. the calc. is selfconsistent
157    lbfgs   =.FALSE., &! if .TRUE. the calc. is a relaxation based on BFGS
158    lmd     =.FALSE., &! if .TRUE. the calc. is a dynamics
159    lwf     =.FALSE., &! if .TRUE. the calc. is with wannier functions
160    !=================================================================
161    !exx_wf related
162    lwfnscf =.FALSE., &
163    lwfpbe0nscf=.FALSE.,&
164    !=================================================================
165    lbands  =.FALSE., &! if .TRUE. the calc. is band structure
166    lconstrain=.FALSE.,&! if .TRUE. the calc. is constraint
167    llondon =.FALSE., & ! if .TRUE. compute Grimme D2 dispersion corrections
168    ldftd3 =.FALSE., & ! if .TRUE. compute Grimme D3 dispersion corrections
169    ts_vdw  =.FALSE., & ! as above for Tkatchenko-Scheffler disp.corrections
170    lxdm    =.FALSE., & ! if .TRUE. compute XDM dispersion corrections
171    lensemb =.FALSE., &! if .TRUE. compute ensemble energies
172    restart =.FALSE.   ! if .TRUE. restart from results of a preceding run
173  !
174  ! ... pw self-consistency
175  !
176  INTEGER, PUBLIC :: &
177    ngm0,             &! used in mix_rho
178    niter,            &! the maximum number of iteration
179    nmix,             &! the number of iteration kept in the history
180    imix               ! the type of mixing (0=plain,1=TF,2=local-TF)
181  INTEGER,  PUBLIC :: &
182    n_scf_steps        ! number of scf iterations to reach convergence
183  REAL(DP), PUBLIC :: &
184    mixing_beta,      &! the mixing parameter
185    tr2,              &! the convergence threshold for potential
186    scf_error=0.0      ! actual convergence reached
187
188  LOGICAL, PUBLIC :: &
189    conv_elec          ! if .TRUE. electron convergence has been reached
190  ! next 3 variables used for EXX calculations
191  LOGICAL, PUBLIC :: &
192    adapt_thr       ! if .TRUE. an adaptive convergence threshold is used
193                       ! for the scf cycle in an EXX calculation.
194  REAL(DP), PUBLIC  :: &
195    tr2_init,         &! initial value of tr2 for adaptive thresholds
196    tr2_multi          ! the dexx multiplier for adaptive thresholds
197                       ! tr2 = tr2_multi * dexx after each V_exx update
198  LOGICAL, PUBLIC :: scf_must_converge
199  !
200  ! ... pw diagonalization
201  !
202  REAL(DP), PUBLIC  :: &
203    ethr               ! the convergence threshold for eigenvalues
204  INTEGER, PUBLIC :: &
205    isolve,           &! index selecting Davidson,  CG , PPCG or ParO diagonalization
206    david,            &! max dimension of subspace in Davidson diagonalization
207    max_cg_iter,      &! maximum number of iterations in a CG call
208    max_ppcg_iter      ! maximum number of iterations in a PPCG call
209  LOGICAL, PUBLIC :: &
210    diago_full_acc = .FALSE. ! if true,  empty eigenvalues have the same
211                             ! accuracy of the occupied ones
212  !
213  ! ... ionic dynamics
214  !
215  INTEGER, PUBLIC :: &
216    nstep = 1,       &! number of ionic steps
217    istep = 0          ! current ionic step
218  LOGICAL, PUBLIC :: &
219    conv_ions          ! if .TRUE. ionic convergence has been reached
220  REAL(DP), PUBLIC  :: &
221    upscale            ! maximum reduction of convergence threshold
222  !
223  ! ... system's symmetries
224  !
225  LOGICAL, PUBLIC :: &
226    noinv = .FALSE.    ! if .TRUE. q=>-q symmetry not used in k-point generation
227  !
228  ! ... phonon calculation
229  !
230  INTEGER, PUBLIC :: &
231    modenum            ! for single mode phonon calculation
232  !
233  ! ... printout control
234  !
235  INTEGER, PUBLIC :: &
236    io_level = 1       ! variable controlling the amount of I/O to file
237  INTEGER, PUBLIC :: & ! variable controlling the amount of I/O to output
238    iverbosity = 0     ! -1 minimal, 0 low, 1 medium, 2 high, 3 debug
239  !
240  ! ... miscellany
241  !
242  LOGICAL, PUBLIC :: &
243    use_para_diag = .FALSE.  ! if .TRUE. a fully distributed memory iteration
244                             ! algorithm and parallel Householder algorithm are used
245  !
246  LOGICAL, PUBLIC :: &
247    remove_rigid_rot = .FALSE. ! if .TRUE. the total torque acting on the atoms
248                               ! is removed
249  LOGICAL, PUBLIC :: &
250    do_makov_payne = .FALSE.   ! if .TRUE. makov-payne correction for isolated
251                               ! system is used
252  !
253  INTEGER  :: ortho_max = 0      ! maximum number of iterations in routine ortho
254  REAL(DP) :: ortho_eps = 0.0_DP ! threshold for convergence in routine ortho
255  !
256  ! ... Number of neighbouring cell to consider in ewald sum
257  !
258  INTEGER, PUBLIC :: iesr = 1
259  !
260  ! ... Real-sapce algorithms
261  !
262  LOGICAL,          PUBLIC :: tqr=.FALSE. ! if true the Q are in real space
263
264  !LOGICAL,          PUBLIC :: real_space=.false. ! beta functions in real space
265  !
266  ! ... Augmetation charge and beta smoothing
267  !
268  LOGICAL,          PUBLIC :: tq_smoothing=.FALSE. ! if true the Q are smoothed
269  LOGICAL,          PUBLIC :: tbeta_smoothing=.FALSE. ! if true the betas are smoothed
270  !
271  ! ... External Forces on Ions
272  !
273  LOGICAL,          PUBLIC :: textfor = .FALSE.
274
275
276  LOGICAL,          PUBLIC :: treinit_gvecs = .FALSE.
277
278  !
279  ! ...  end of module-scope declarations
280  !
281  !=--------------------------------------------------------------------------=!
282  CONTAINS
283  !=--------------------------------------------------------------------------=!
284    !
285    !------------------------------------------------------------------------
286    SUBROUTINE fix_dependencies()
287      !------------------------------------------------------------------------
288      !
289      IMPLICIT NONE
290      !
291      ! ... if thdyn = .FALSE. set TSDC and TZEROC to .FALSE. too.
292      !
293      IF ( .NOT. thdyn ) THEN
294         !
295         tsdc   = .FALSE.
296         tzeroc = .FALSE.
297         !
298      END IF
299      !
300      IF ( .NOT. tfor ) THEN
301         !
302         tzerop = .FALSE.
303         tv0rd  = .FALSE.
304         tsdp   = .FALSE.
305         tcp    = .FALSE.
306         tcap   = .FALSE.
307         tnosep = .FALSE.
308         !
309      ELSE
310         !
311         IF ( tsdp ) THEN
312            !
313            tcp    = .FALSE.
314            tcap   = .FALSE.
315            tnosep = .FALSE.
316            tv0rd  = .FALSE.
317            !
318         END IF
319         !
320         IF ( tv0rd ) tzerop = .TRUE.
321         !
322      END IF
323      !
324      IF ( tsde ) tnosee = .FALSE.
325      !
326      CALL check_flags()
327      !
328      RETURN
329      !
330    END SUBROUTINE fix_dependencies
331    !
332    !------------------------------------------------------------------------
333    SUBROUTINE check_flags()
334      !------------------------------------------------------------------------
335      !
336      ! ...  do some checks for consistency
337      !
338      IF ( tnosep .AND. tcp ) &
339         CALL errore( ' control_flags ', ' TCP AND TNOSEP BOTH TRUE', 0 )
340      !
341      IF ( tnosep .AND. tcap ) &
342         CALL errore( ' control_flags ', ' TCAP AND TNOSEP BOTH TRUE', 0 )
343      !
344      IF ( tcp .AND. tcap ) &
345         CALL errore( ' control_flags ', ' TCP AND TCAP BOTH TRUE', 0 )
346      !
347      IF ( tv0rd .AND. tsdp ) &
348         CALL errore( ' control_flags ', &
349                    & ' READING IONS VELOCITY WITH STEEPEST D.', 0 )
350      !
351      RETURN
352      !
353    END SUBROUTINE check_flags
354    !
355END MODULE control_flags
356
357