1!
2!
3! Copyright (C) 2001-2013 Quantum ESPRESSO group
4! This file is distributed under the terms of the
5! GNU General Public License. See the file `License'
6! in the root directory of the present distribution,
7! or http://www.gnu.org/copyleft/gpl.txt .
8!
9!
10
11! Author: L. Martin-Samos
12!
13!----------------------------------------------------------------------------
14SUBROUTINE openfil_pw4gww()
15  !----------------------------------------------------------------------------
16  !
17  ! ... This routine opens all files needed to the self consistent run,
18  ! ... sets various file names, units, record lengths
19  !
20  USE kinds,          ONLY : DP
21  USE wvfct,          ONLY : nbnd, npwx
22  USE io_files,       ONLY : prefix, tmp_dir, iunwfc, nwordwfc, iunsat, nwordatwfc, diropn
23  USE noncollin_module, ONLY : npol
24  USE ldaU,             ONLY : lda_plus_u
25  USE basis,            ONLY : natomwfc
26  USE ions_base,        ONLY : nat, ityp
27  USE noncollin_module,   ONLY : noncolin
28  USE uspp_param,         ONLY : n_atom_wfc
29  !
30  IMPLICIT NONE
31  !
32  LOGICAL       :: exst
33  !
34  !
35  ! ... nwordwfc is the record length for the direct-access file
36  ! ... containing wavefunctions
37  !
38  nwordwfc = nbnd * npwx * npol
39  !
40  CALL diropn( iunwfc, 'wfc', 2*nwordwfc, exst )
41  !
42  IF ( .NOT. exst ) THEN
43     call errore ('openfil_pw4gww','file '//TRIM( prefix )//'.wfc'//' not found',1)
44  END IF
45  !
46  ! ... Needed for LDA+U
47  !
48  ! ... iunat  contains the (orthogonalized) atomic wfcs
49  ! ... iunsat contains the (orthogonalized) atomic wfcs * S
50  ! ... iunocc contains the atomic occupations computed in new_ns
51  ! ... it is opened and closed for each reading-writing operation
52  !
53  natomwfc = n_atom_wfc( nat, ityp, noncolin )
54  nwordatwfc = 2*npwx*natomwfc*npol
55  !
56  IF ( lda_plus_u ) then
57     !CALL diropn( iunat,  'atwfc',  nwordatwfc, exst )
58     IF ( .NOT. exst ) THEN
59        call errore ('openfil_pw4gww','file '//TRIM( prefix )//'.atwfc'//' not found',1)
60     END IF
61
62     CALL diropn( iunsat, 'satwfc', nwordatwfc, exst )
63     IF ( .NOT. exst ) THEN
64        call errore ('openfil_pw4gww','file '//TRIM( prefix )//'.satwfc'//' not found',1)
65     END IF
66  END IF
67  !
68
69  RETURN
70  !
71END SUBROUTINE openfil_pw4gww
72