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 save_in_cbands (ik, ethr, avg_iter, 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 (in) :: ik
20  REAL(dp), INTENT(in) :: ethr, avg_iter, et(nbnd,nks)
21  !
22  LOGICAL :: exst
23  !
24  WRITE(stdout,'(5x,"Calculation stopped in k-point loop, point #",i6)') ik
25  CALL seqopn (iunres, 'restart_k', 'formatted', exst)
26  WRITE (iunres, *) ik, ethr, avg_iter
27  WRITE (iunres, *) et(1:nbnd,1:nks)
28  CLOSE ( unit=iunres, status='keep')
29  !
30END SUBROUTINE save_in_cbands
31!
32!-----------------------------------------------------------------------
33SUBROUTINE restart_in_cbands (ik, ethr, avg_iter, et)
34  !-----------------------------------------------------------------------
35  USE kinds,         ONLY: dp
36  USE io_global,     ONLY: stdout
37  USE io_files,      ONLY: iunres, seqopn
38  USE klist,         ONLY: nks
39  USE wvfct,         ONLY: nbnd
40  !
41  IMPLICIT NONE
42  !
43  INTEGER, INTENT (inout) :: ik
44  REAL(dp), INTENT(inout) :: ethr, avg_iter, et(nbnd,nks)
45  !
46  REAL(dp), ALLOCATABLE :: et_(:,:)
47  REAL(dp):: ethr_, avg_iter_
48  INTEGER :: ios
49  LOGICAL :: exst
50  !
51  CALL seqopn (iunres, 'restart_k', 'formatted', exst)
52  IF ( exst ) THEN
53     ios = 0
54     READ (iunres, *, iostat=ios) ik, ethr_, avg_iter_
55     IF ( ios /= 0 ) THEN
56        ik = 0
57     ELSE IF ( ik < 1 .OR. ik > nks ) THEN
58        ik = 0
59     ELSE
60        ALLOCATE (et_(nbnd,nks))
61        READ (iunres, *, iostat=ios) et_
62        IF ( ios /= 0 ) THEN
63           ik = 0
64        ELSE
65           IF ( ik == nks ) THEN
66              WRITE( stdout, &
67               '(5x,"Calculation restarted from end of k-point loop")' )
68           ELSE
69              WRITE( stdout, &
70               '(5x,"Calculation restarted from kpoint #",i6)' ) ik + 1
71           END IF
72           ethr = ethr_
73           avg_iter = avg_iter_
74           et (:,:) = et_(:,:)
75        END IF
76        DEALLOCATE (et_)
77     END IF
78  ELSE
79     ik = 0
80  END IF
81  CLOSE ( unit=iunres, status='delete')
82  !
83END SUBROUTINE restart_in_cbands
84