From 995b8ecfeb535e9bd607cb2b3481b20de8775e5f Mon Sep 17 00:00:00 2001 From: giannozz Date: Sat, 2 Jan 2016 13:24:44 +0000 Subject: [PATCH] Extrapolation machinery moved to a module, related variables removed from control_flags; no other changes. A few updates to make.depend files. git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@11933 c92efa57-630b-4861-b058-cf58834340f0 --- Modules/control_flags.f90 | 12 +----------- NEB/src/compute_scf.f90 | 1 + NEB/src/make.depend | 3 +-- PHonon/Gamma/make.depend | 1 + PHonon/Gamma/phcg.f90 | 5 ++--- PW/src/input.f90 | 3 ++- PW/src/make.depend | 4 ++-- PW/src/run_pwscf.f90 | 1 + PW/src/update_pot.f90 | 36 +++++++++++++++++++++++------------- 9 files changed, 34 insertions(+), 32 deletions(-) diff --git a/Modules/control_flags.f90 b/Modules/control_flags.f90 index aa4cebe1e..aa313bf5c 100644 --- a/Modules/control_flags.f90 +++ b/Modules/control_flags.f90 @@ -1,5 +1,5 @@ ! -! Copyright (C) 2002-2011 Quantum ESPRESSO group +! Copyright (C) 2002-2016 Quantum ESPRESSO group ! This file is distributed under the terms of the ! GNU General Public License. See the file `License' ! in the root directory of the present distribution, @@ -201,16 +201,6 @@ MODULE control_flags diago_full_acc = .FALSE. ! if true, empty eigenvalues have the same ! accuracy of the occupied ones ! - ! ... wfc and rho extrapolation - ! - REAL(DP), PUBLIC :: & - alpha0, &! the mixing parameters for the extrapolation - beta0 ! of the starting potential - INTEGER, PUBLIC :: & - history, &! number of old steps available for potential updating - pot_order = 0, &! type of potential updating ( see update_pot ) - wfc_order = 0 ! type of wavefunctions updating ( see update_pot ) - ! ! ... ionic dynamics ! INTEGER, PUBLIC :: & diff --git a/NEB/src/compute_scf.f90 b/NEB/src/compute_scf.f90 index 0c63170bb..0abd07ac2 100644 --- a/NEB/src/compute_scf.f90 +++ b/NEB/src/compute_scf.f90 @@ -43,6 +43,7 @@ SUBROUTINE compute_scf( fii, lii, stat ) USE fcp_opt_routines, ONLY : fcp_neb_nelec, fcp_neb_ef USE fcp_variables, ONLY : lfcpopt USE klist, ONLY : nelec, tot_charge + USE extrapolation, ONLY : update_neb ! IMPLICIT NONE ! diff --git a/NEB/src/make.depend b/NEB/src/make.depend index c5dd1139b..183753d7f 100644 --- a/NEB/src/make.depend +++ b/NEB/src/make.depend @@ -2,7 +2,6 @@ compute_scf.o : ../../Modules/cell_base.o compute_scf.o : ../../Modules/constants.o compute_scf.o : ../../Modules/control_flags.o compute_scf.o : ../../Modules/fcp_variables.o -compute_scf.o : ../../Modules/fft_base.o compute_scf.o : ../../Modules/input_parameters.o compute_scf.o : ../../Modules/io_files.o compute_scf.o : ../../Modules/io_global.o @@ -11,9 +10,9 @@ compute_scf.o : ../../Modules/kind.o compute_scf.o : ../../Modules/mp.o compute_scf.o : ../../Modules/mp_global.o compute_scf.o : ../../Modules/mp_world.o -compute_scf.o : ../../Modules/recvec.o compute_scf.o : ../../PW/src/atomic_wfc_mod.o compute_scf.o : ../../PW/src/pwcom.o +compute_scf.o : ../../PW/src/update_pot.o compute_scf.o : fcp_opt_routines.o compute_scf.o : path_formats.o compute_scf.o : path_io_routines.o diff --git a/PHonon/Gamma/make.depend b/PHonon/Gamma/make.depend index 3b1b261aa..c58f53905 100644 --- a/PHonon/Gamma/make.depend +++ b/PHonon/Gamma/make.depend @@ -155,6 +155,7 @@ phcg.o : ../../PW/src/ldaU.o phcg.o : ../../PW/src/pwcom.o phcg.o : ../../PW/src/scf_mod.o phcg.o : ../../PW/src/symm_base.o +phcg.o : ../../PW/src/update_pot.o phcg.o : cgcom.o pw_dot.o : ../../Modules/kind.o pw_dot.o : ../../Modules/mp.o diff --git a/PHonon/Gamma/phcg.f90 b/PHonon/Gamma/phcg.f90 index 5e101743f..e98356d09 100644 --- a/PHonon/Gamma/phcg.f90 +++ b/PHonon/Gamma/phcg.f90 @@ -494,8 +494,9 @@ SUBROUTINE newscf USE io_files, ONLY : iunigk, iunwfc, input_drho, output_drho USE ldaU, ONLY : lda_plus_u USE control_flags, ONLY : restart, io_level, lscf, iprint, & - pot_order, wfc_order, david, max_cg_iter, & + david, max_cg_iter, & isolve, tr2, ethr, mixing_beta, nmix, niter + USE extrapolation, ONLY : extrapolate_charge ! IMPLICIT NONE INTEGER :: iter @@ -513,8 +514,6 @@ SUBROUTINE newscf lmovecell=.false. qcutz=0.0d0 iprint=10000 - pot_order=0 - wfc_order=0 input_drho=' ' output_drho=' ' starting_wfc='file' diff --git a/PW/src/input.f90 b/PW/src/input.f90 index c07357243..a52edf728 100644 --- a/PW/src/input.f90 +++ b/PW/src/input.f90 @@ -137,8 +137,9 @@ SUBROUTINE iosys() ! USE relax, ONLY : epse, epsf, epsp, starting_scf_threshold ! + USE extrapolation, ONLY : pot_order, wfc_order USE control_flags, ONLY : isolve, max_cg_iter, david, tr2, imix, gamma_only,& - nmix, iverbosity, niter, pot_order, wfc_order, & + nmix, iverbosity, niter, & remove_rigid_rot_ => remove_rigid_rot, & diago_full_acc_ => diago_full_acc, & tolp_ => tolp, & diff --git a/PW/src/make.depend b/PW/src/make.depend index 472e1dce6..e5d87eeb3 100644 --- a/PW/src/make.depend +++ b/PW/src/make.depend @@ -763,7 +763,6 @@ hinit1.o : ../../Modules/wannier_new.o hinit1.o : ldaU.o hinit1.o : martyna_tuckerman.o hinit1.o : newd.o -hinit1.o : paw_init.o hinit1.o : paw_onecenter.o hinit1.o : paw_symmetry.o hinit1.o : pwcom.o @@ -880,6 +879,7 @@ input.o : pwcom.o input.o : realus.o input.o : start_k.o input.o : symm_base.o +input.o : update_pot.o input.o : wyckoff.o input.o : xdm_dispersion.o interpolate.o : ../../FFTXlib/fft_interfaces.o @@ -1074,7 +1074,6 @@ offset_atom_wfc.o : ../../Modules/uspp.o offset_atom_wfc.o : ldaU.o openfil.o : ../../Modules/control_flags.o openfil.o : ../../Modules/io_files.o -openfil.o : ../../Modules/io_global.o openfil.o : ../../Modules/kind.o openfil.o : ../../Modules/noncol.o openfil.o : ../../Modules/wannier_new.o @@ -1520,6 +1519,7 @@ run_pwscf.o : ../../Modules/mp_images.o run_pwscf.o : ../../Modules/parameters.o run_pwscf.o : ../../Modules/qmmm.o run_pwscf.o : pwcom.o +run_pwscf.o : update_pot.o ruotaijk.o : ../../Modules/kind.o s_1psi.o : ../../Modules/becmod.o s_1psi.o : ../../Modules/control_flags.o diff --git a/PW/src/run_pwscf.f90 b/PW/src/run_pwscf.f90 index c89000e97..b8aa21cfc 100644 --- a/PW/src/run_pwscf.f90 +++ b/PW/src/run_pwscf.f90 @@ -34,6 +34,7 @@ SUBROUTINE run_pwscf ( exit_status ) USE force_mod, ONLY : lforce, lstres, sigma, force USE check_stop, ONLY : check_stop_init, check_stop_now USE mp_images, ONLY : intra_image_comm + USE extrapolation, ONLY : update_file, update_pot USE qmmm, ONLY : qmmm_initialization, qmmm_shutdown, & qmmm_update_positions, qmmm_update_forces ! diff --git a/PW/src/update_pot.f90 b/PW/src/update_pot.f90 index 43a312c87..27535aadf 100644 --- a/PW/src/update_pot.f90 +++ b/PW/src/update_pot.f90 @@ -1,5 +1,5 @@ ! -! Copyright (C) 2001-2015 Quantum ESPRESSO group +! Copyright (C) 2001-2016 Quantum ESPRESSO group ! This file is distributed under the terms of the ! GNU General Public License. See the file `License' ! in the root directory of the present distribution, @@ -9,6 +9,26 @@ #define ONE (1.D0,0.D0) #define ZERO (0.D0,0.D0) ! +MODULE extrapolation + ! + ! ... wfc and rho extrapolation + ! + USE kinds, ONLY: dp + ! + REAL(dp) :: & + alpha0, &! the mixing parameters for the extrapolation + beta0 ! of the starting potential + INTEGER :: & + history, &! number of old steps available for potential updating + pot_order = 0, &! type of potential updating ( see update_pot ) + wfc_order = 0 ! type of wavefunctions updating ( see update_pot ) + ! + PRIVATE + PUBLIC :: pot_order, wfc_order + PUBLIC :: update_file, update_neb, update_pot, extrapolate_charge + ! + CONTAINS +! !---------------------------------------------------------------------------- SUBROUTINE update_file ( ) !---------------------------------------------------------------------------- @@ -19,7 +39,6 @@ SUBROUTINE update_file ( ) ! ... Produces: length of history and tau at current and two previous steps ! ... written to file $prefix.update ! - USE kinds, ONLY : DP USE io_global, ONLY : ionode USE io_files, ONLY : iunupdate, seqopn USE ions_base, ONLY : nat, tau @@ -27,7 +46,6 @@ SUBROUTINE update_file ( ) IMPLICIT NONE ! REAL(DP), ALLOCATABLE :: tauold(:,:,:) - INTEGER :: history LOGICAL :: exst ! IF ( ionode ) THEN @@ -76,8 +94,6 @@ SUBROUTINE update_neb ( ) ! ... Prepares file with previous steps for usage by update_pot ! ... Must be merged soon with update_file for MD in PWscf ! - USE kinds, ONLY : DP - USE control_flags, ONLY : pot_order, history USE io_global, ONLY : ionode, ionode_id USE io_files, ONLY : iunupdate, seqopn USE mp, ONLY : mp_bcast @@ -221,8 +237,6 @@ SUBROUTINE update_pot() ! ... + beta0*( tau(t-dt) -tau(t-2*dt) ) ! ! - USE kinds, ONLY : DP - USE control_flags, ONLY : pot_order, wfc_order, history, alpha0, beta0 USE io_files, ONLY : prefix, iunupdate, tmp_dir, wfc_dir, nd_nmbr, seqopn USE io_global, ONLY : ionode, ionode_id USE cell_base, ONLY : bg @@ -374,7 +388,6 @@ SUBROUTINE extrapolate_charge( rho_extr ) ! USE constants, ONLY : eps32 USE io_global, ONLY : stdout - USE kinds, ONLY : DP USE cell_base, ONLY : omega, bg USE ions_base, ONLY : nat, tau, nsp, ityp USE fft_base, ONLY : dfftp, dffts @@ -384,7 +397,6 @@ SUBROUTINE extrapolate_charge( rho_extr ) USE scf, ONLY : rho, rho_core, rhog_core, v USE ldaU, ONLY : eth USE wavefunctions_module, ONLY : psic - USE control_flags, ONLY : alpha0, beta0 USE ener, ONLY : ehart, etxc, vtxc, epaw USE extfield, ONLY : etotefield USE cellmd, ONLY : lmovecell, omega_old @@ -615,10 +627,8 @@ SUBROUTINE extrapolate_wfcs( wfc_extr ) ! ... by Mead, Rev. Mod. Phys., vol 64, pag. 51 (1992), eqs. 3.20-3.29 ! USE io_global, ONLY : stdout - USE kinds, ONLY : DP USE klist, ONLY : nks, ngk, xk USE lsda_mod, ONLY : lsda, current_spin, isk - USE control_flags, ONLY : alpha0, beta0, wfc_order USE wvfct, ONLY : nbnd, npw, npwx, igk, current_k USE ions_base, ONLY : nat, tau USE io_files, ONLY : nwordwfc, iunigk, iunwfc, iunoldwfc, & @@ -861,9 +871,7 @@ SUBROUTINE find_alpha_and_beta( nat, tau, tauold, alpha0, beta0 ) ! ... + beta0 * ( tau(t-dt) -tau(t-2*dt) ) ! USE constants, ONLY : eps16 - USE kinds, ONLY : DP USE io_global, ONLY : stdout - USE control_flags, ONLY : history ! IMPLICIT NONE ! @@ -944,3 +952,5 @@ SUBROUTINE find_alpha_and_beta( nat, tau, tauold, alpha0, beta0 ) RETURN ! END SUBROUTINE find_alpha_and_beta + ! +END MODULE extrapolation