1!
2! Copyright (C) 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!-----------------------------------------------------------------------
9SUBROUTINE restart_in_electrons (iter, dr2, ethr, et)
10  !-----------------------------------------------------------------------
11  USE kinds,         ONLY: dp
12  USE io_global,     ONLY: stdout
13  USE io_files,      ONLY: iunres, seqopn
14  USE klist,         ONLY: nks
15  USE wvfct,         ONLY: nbnd
16  !
17  IMPLICIT NONE
18  !
19  INTEGER, INTENT (inout) :: iter
20  REAL(dp), INTENT(inout) :: dr2, ethr, et(nbnd,nks)
21  !
22  REAL(dp), ALLOCATABLE :: et_(:,:)
23  REAL(dp):: dr2_, ethr_
24  INTEGER :: ios
25  LOGICAL :: exst
26  !
27  CALL seqopn (iunres, 'restart_scf', 'formatted', exst)
28  IF ( exst ) THEN
29     ios = 0
30     READ (iunres, *, iostat=ios) iter, dr2_, ethr_
31     IF ( ios /= 0 ) THEN
32        iter = 0
33     ELSE IF ( iter < 1 ) THEN
34        iter = 0
35     ELSE
36        ALLOCATE (et_(nbnd,nks))
37        READ (iunres, *, iostat=ios) et_
38        IF ( ios /= 0 ) THEN
39           iter = 0
40        ELSE
41           WRITE( stdout, &
42           '(5x,"Calculation restarted from scf iteration #",i6)' ) iter + 1
43           dr2 = dr2_
44           ethr= ethr_
45           et (:,:) = et_(:,:)
46        END IF
47        DEALLOCATE (et_)
48     END IF
49  ELSE
50     iter = 0
51  END IF
52  CLOSE ( unit=iunres, status='delete')
53  !
54END SUBROUTINE restart_in_electrons
55