1!
2! Copyright (C) 2001-2009 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!-----------------------------------------------------------------------
9PROGRAM initial_state
10  !-----------------------------------------------------------------------
11  !
12  !  compute initial-state contribution to core level shift
13  !
14  ! input: namelist "&inputpp", with variables
15  !   prefix      prefix of input files saved by program pwscf
16  !   outdir      temporary directory where files resides
17  !
18  USE io_global,  ONLY : stdout, ionode, ionode_id
19  USE kinds,      ONLY : DP
20  USE io_files,   ONLY : prefix, tmp_dir, iunwfc, nwordwfc
21  USE ions_base,  ONLY : nat
22  USE klist,      ONLY : nks, xk, igk_k, ngk
23  USE uspp,       ONLY : nkb, vkb
24  USE wavefunctions, ONLY : evc
25  USE parameters, ONLY : ntypx
26  USE mp,         ONLY : mp_bcast
27  USE mp_world,   ONLY : world_comm
28  USE mp_global,  ONLY : mp_startup
29  USE environment,ONLY : environment_start, environment_end
30  !
31  IMPLICIT NONE
32  !
33  CHARACTER(LEN=256), EXTERNAL :: trimcheck
34  !
35  CHARACTER(len=256) :: outdir
36  INTEGER :: ios, ik, excite(ntypx)
37  LOGICAL :: needwf = .TRUE.
38  NAMELIST / inputpp / outdir, prefix, excite
39  !
40  ! initialise environment
41  !
42  CALL mp_startup ( )
43  CALL environment_start ( 'initstate' )
44  !
45  !   set default values for variables in namelist
46  !
47  excite(:) = 0
48  prefix = 'pwscf'
49  CALL get_environment_variable( 'ESPRESSO_TMPDIR', outdir )
50  IF ( trim( outdir ) == ' ' ) outdir = './'
51  !
52  ios = 0
53  !
54  IF ( ionode )  THEN
55     !
56     CALL input_from_file ( )
57     !
58     READ (5, inputpp, iostat = ios)
59     !
60     tmp_dir = trimcheck (outdir)
61     !
62  ENDIF
63  !
64  CALL mp_bcast ( ios, ionode_id, world_comm )
65  !
66  IF ( ios /= 0) &
67     CALL errore ('postforces', 'reading inputpp namelist', abs (ios) )
68  !
69  ! ... Broadcast variables
70  !
71  CALL mp_bcast( tmp_dir, ionode_id, world_comm )
72  CALL mp_bcast( prefix, ionode_id, world_comm )
73  CALL mp_bcast( excite, ionode_id, world_comm )
74  !
75  !   Now allocate space for pwscf variables, read and check them.
76  !
77  CALL read_file_new( needwf )
78  !
79  CALL do_initial_state (excite)
80  !
81  CALL environment_end ( 'initstate' )
82  !
83  CALL stop_pp
84  !
85
86END PROGRAM initial_state
87