1!
2! Copyright (C) 2001-2020 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 openfil()
10  !----------------------------------------------------------------------------
11  !! This routine opens some files needed to the self consistent run,
12  !! sets various file names, units, record lengths.
13  !! All units are set in Modules/io_files.f90
14  !
15  USE kinds,            ONLY : DP
16  USE buffers,          ONLY : open_buffer
17  USE control_flags,    ONLY : io_level
18  USE basis,            ONLY : natomwfc
19  USE wvfct,            ONLY : nbnd, npwx
20  USE fixed_occ,        ONLY : one_atom_occupations
21  USE ldaU,             ONLY : lda_plus_U, U_projection, nwfcU
22  USE io_files,         ONLY : prefix, iunpun, iunsat, &
23                               iunhub, nwordwfcU, nwordwfc, nwordatwfc, &
24                               iunefield, iunefieldm, iunefieldp, seqopn
25  USE noncollin_module, ONLY : npol
26  USE bp,               ONLY : lelfield
27  USE wannier_new,      ONLY : use_wannier
28#if defined(__HDF5) && defined(__MPI)
29  USE hdf5_qe,          ONLY : initialize_hdf5
30#endif
31  !
32  IMPLICIT NONE
33  !
34  LOGICAL :: exst
35  !
36  ! ... Files needed for DFT+U(+V)
37  ! ... iunsat contains the (orthogonalized) atomic wfcs * S
38  ! ... iunhub  as above, only wfcs * S with a U correction
39  !
40  ! ... nwordwfc is the record length (IN COMPLEX WORDS)
41  ! ... for the direct-access file containing wavefunctions
42  ! ... nwordatwfc/nwordwfcU as above for atomic/U-manifold wavefunctions
43  !
44  nwordwfc  = nbnd*npwx*npol
45  nwordatwfc= npwx*natomwfc*npol
46  nwordwfcU = npwx*nwfcU*npol
47  !
48  IF ( lda_plus_u .AND. (U_projection.NE.'pseudo') ) THEN
49     CALL open_buffer( iunhub,  'hub',  nwordwfcU, io_level, exst )
50  ENDIF
51  IF ( use_wannier .OR. one_atom_occupations ) &
52     CALL open_buffer( iunsat, 'satwfc', nwordatwfc, io_level, exst )
53  !
54  ! ... open units for electric field calculations
55  !
56  IF ( lelfield ) THEN
57      CALL open_buffer( iunefield , 'ewfc' , nwordwfc, io_level, exst )
58      CALL open_buffer( iunefieldm, 'ewfcm', nwordwfc, io_level, exst )
59      CALL open_buffer( iunefieldp, 'ewfcp', nwordwfc, io_level, exst )
60  ENDIF
61  !
62#if defined(__HDF5) && defined(__MPI)
63  ! calls h5open_f mandatory in any application using hdf5
64  CALL initialize_hdf5()
65#endif
66  !
67END SUBROUTINE openfil
68