1!
2! Copyright (C) 2001-2013 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!
9!-----------------------------------------------------------------------
10  SUBROUTINE non_scf_ph ( )
11  !-----------------------------------------------------------------------
12  !
13  ! ... diagonalization of the KS hamiltonian in the non-scf case
14  !
15  USE kinds,                ONLY : DP
16  USE bp,                   ONLY : lelfield, lberry, lorbm
17  USE check_stop,           ONLY : stopped_by_user
18  USE control_flags,        ONLY : io_level, conv_elec, lbands
19  USE ener,                 ONLY : ef
20  USE io_global,            ONLY : stdout, ionode
21  USE io_files,             ONLY : iunwfc, nwordwfc, iunefield
22  USE buffers,              ONLY : save_buffer
23  USE klist,                ONLY : xk, wk, nks, nkstot
24  USE lsda_mod,             ONLY : lsda, nspin
25  USE wvfct,                ONLY : nbnd, et, npwx
26  USE wavefunctions, ONLY : evc
27  !
28  IMPLICIT NONE
29  !
30  ! ... local variables
31  !
32  INTEGER :: iter, i
33  REAL(DP), EXTERNAL :: get_clock
34  !
35  !
36  CALL start_clock( 'electrons' )
37  iter = 1
38  !
39  WRITE( stdout, 9002 )
40  FLUSH( stdout )
41  !
42  IF ( lelfield) THEN
43     !
44     CALL c_bands_efield ( iter )
45     !
46  ELSE
47     !
48     CALL c_bands_nscf_ph ( )
49     !
50  END IF
51  !
52  ! ... check if calculation was stopped in c_bands
53  !
54  IF ( stopped_by_user ) THEN
55     conv_elec=.FALSE.
56     RETURN
57  END IF
58  !
59  ! ... xk, wk, isk, et, wg are distributed across pools;
60  ! ... the first node has a complete copy of xk, wk, isk,
61  ! ... while eigenvalues et and weights wg must be
62  ! ... explicitly collected to the first node
63  ! ... this is done here for et, in weights () for wg
64  !
65  CALL poolrecover( et, nbnd, nkstot, nks )
66  !
67  ! ... calculate weights of Kohn-Sham orbitals (only weights, not Ef,
68  ! ... for a "bands" calculation where Ef is read from data file)
69  ! ... may be needed in further calculations such as phonon
70  !
71  IF ( lbands ) THEN
72     CALL weights_only  ( )
73  ELSE
74     CALL weights  ( )
75  END IF
76  !
77  ! ... Note that if you want to use more k-points for the phonon
78  ! ... calculation then those needed for self-consistency, you can,
79  ! ... by performing a scf with less k-points, followed by a non-scf
80  ! ... one with additional k-points, whose weight on input is set to zero
81  !
82  WRITE( stdout, 9000 ) get_clock( 'PWSCF' )
83  !
84  WRITE( stdout, 9102 )
85  !
86  ! ... write band eigenvalues (conv_elec is used in print_ks_energies)
87  !
88  conv_elec = .true.
89  CALL print_ks_energies ( )
90  !
91  ! ... save converged wfc if they have not been written previously
92  ! ... FIXME: it shouldn't be necessary to do this here
93  !
94  IF ( nks == 1 .AND. (io_level < 2) .AND. (io_level > -1) ) &
95        CALL save_buffer ( evc, nwordwfc, iunwfc, nks )
96  !
97  ! ... do a Berry phase polarization calculation if required
98  !
99  IF ( lberry ) CALL c_phase()
100  !
101  ! ... do an orbital magnetization (Kubo terms) calculation
102  !
103  IF ( lorbm ) CALL orbm_kubo()
104  !
105  CALL stop_clock( 'electrons' )
106  !
1079000 FORMAT(/'     total cpu time spent up to now is ',F10.1,' secs' )
1089002 FORMAT(/'     Band Structure Calculation' )
1099102 FORMAT(/'     End of band structure calculation' )
110  !
111END SUBROUTINE non_scf_ph
112
113