-
Notifications
You must be signed in to change notification settings - Fork 3
/
parse.f90
320 lines (277 loc) · 15.3 KB
/
parse.f90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
#include "alias.inc"
subroutine parse_very_init(PINPT)
use parameters, only: incar
use mpi_setup
use mykind
use utils, only: flag_number
implicit none
type(incar) :: PINPT
integer(kind=sp) narg, iarg, i, idummy
character(len=256) option, value, dummy
logical flag_set_folder_out_by_hand
PINPT%fnamelog = 'VASPBAUM.out' ! default
PINPT%title = ''
PINPT%folder_in= './'
PINPT%folder_out= './'
flag_set_folder_out_by_hand = .false.
narg = iargc()
do iarg = 1, narg
call getarg(iarg, option)
if(.not. flag_number(trim(option))) then
if(trim(option) .eq. '-log' .or. trim(option) .eq. '-o') then
call getarg(iarg+1, PINPT%fnamelog) ! set output file name
elseif(trim(option) .eq. '-path') then
call getarg(iarg+1, PINPT%folder_in)
idummy = len_trim(PINPT%folder_in)
if(PINPT%folder_in(idummy:idummy) .ne. '/') then
PINPT%folder_in = trim(PINPT%folder_in)//'/'
endif
elseif(trim(option) .eq. '-path_out') then
call getarg(iarg+1, PINPT%folder_out)
idummy = len_trim(PINPT%folder_out)
if(PINPT%folder_out(idummy:idummy) .ne. '/') then
PINPT%folder_out = trim(PINPT%folder_out)//'/'
endif
flag_set_folder_out_by_hand = .true.
endif
endif
enddo
if(.not. flag_set_folder_out_by_hand) then
PINPT%folder_out = trim(PINPT%folder_in)
endif
write(dummy,'(A)')trim(PINPT%folder_out)//trim(PINPT%fnamelog)
PINPT%fnamelog = trim(dummy)
return
endsubroutine
subroutine parse(PINPT)
use parameters, only: incar
use mpi_setup
use mykind
use print_io
use utils, only: flag_number
implicit none
type(incar ) :: PINPT
integer(kind=sp) narg, iarg, i
integer(kind=sp) iverbose_
character(len=256) option, value
character(len=256) dummy
narg = iargc()
write(PINPT%filenm,'(A)') trim(PINPT%folder_in)//'WAVECAR'
PINPT%title = 'VASPBAUM.OUT'
PINPT%nelect = 0 ! default
PINPT%ie_init = 1
PINPT%ie_fina = 999999
PINPT%ispinor = 2 ! default
PINPT%icd = 0
PINPT%init_e = -999.d0
PINPT%fina_e = -999.d0
PINPT%sigma = 0.01d0
PINPT%theta = 0.0d0
PINPT%phi = 0.0d0
PINPT%nediv = 1000
PINPT%e_fermi = 0.0d0
PINPT%nkdiv = 0 ! should be asigned via -nkdiv
PINPT%flag_norm = .FALSE.
PINPT%flag_unfold = .FALSE.
PINPT%flag_set_unfold = .FALSE.
PINPT%flag_reduce = .TRUE.
iverbose = 1 ! 1:full, 2:no
print_mode = 3 ! default verbosity
do iarg = 1, narg
call getarg(iarg, option)
if(.not. flag_number(trim(option))) then
if(trim(option) .eq. '-h') then
if_main call help()
elseif(trim(option) .eq. '-v') then
call getarg(iarg+1, value)
read(value, *) iverbose_
elseif(trim(option) .eq. '-wf' .or. trim(option) .eq. '-f' ) then
call getarg(iarg+1, PINPT%filenm)
elseif(trim(option) .eq. '-s') then
call getarg(iarg+1, value)
read(value, *) PINPT%ispinor
elseif(trim(option) .eq. '-soc') then
PINPT%ispinor = 2
elseif(trim(option) .eq. '-nosoc') then
PINPT%ispinor = 1
elseif(trim(option) .eq. '-t') then
call getarg(iarg+1, PINPT%title)
elseif(trim(option) .eq. '-norm') then
call getarg(iarg+1, value)
read(value,*) PINPT%flag_norm
elseif(trim(option) .eq. '-nkdiv') then
call getarg(iarg+1, value)
read(value, *) PINPT%nkdiv
elseif(trim(option) .eq. '-ne') then
call getarg(iarg+1, value)
read(value, *) PINPT%nelect
elseif(trim(option) .eq. '-ii') then
call getarg(iarg+1, value)
read(value, *) PINPT%ie_init
elseif(trim(option) .eq. '-if') then
call getarg(iarg+1, value)
read(value, *) PINPT%ie_fina
elseif(trim(option) .eq. '-is') then
call getarg(iarg+1, value)
read(value, *) PINPT%ie_init
PINPT%ie_fina = PINPT%ie_init
elseif(trim(option) .eq. '-cd') then
call getarg(iarg+1, value)
read(value, *) PINPT%icd
elseif(trim(option) .eq. '-unfold') then
PINPT%flag_unfold = .TRUE.
elseif(trim(option) .eq. '-set_unfold')then
PINPT%flag_set_unfold = .TRUE.
elseif(trim(option) .eq. '-no_reduce') then
PINPT%flag_reduce = .FALSE.
elseif(trim(option) .eq. '-ef') then
call getarg(iarg+1, value)
read(value, *) PINPT%e_fermi
else if(trim(option) .eq. "-ien") then
call getarg(iarg+1, value)
read(value,*) PINPT%init_e
else if(trim(option) .eq. "-fen") then
call getarg(iarg+1, value)
read(value,*) PINPT%fina_e
else if(trim(option) .eq. "-theta") then
call getarg(iarg+1, value)
read(value,*) PINPT%theta
else if(trim(option) .eq. "-phi") then
call getarg(iarg+1, value)
read(value,*) PINPT%phi
else if(trim(option) .eq. "-nediv") then
call getarg(iarg+1, value)
read(value,*) PINPT%nediv
else if(trim(option) .eq. "-sigma") then
call getarg(iarg+1, value)
read(value,*) PINPT%sigma
endif
endif
enddo
if(PINPT%icd .eq. 2 .and. PINPT%flag_unfold ) then
PINPT%icd = 3
endif
if(PINPT%icd .eq. 3 .and. PINPT%flag_unfold .eq. .FALSE.) then
PINPT%flag_unfold = .TRUE.
endif
iverbose = iverbose_
return
endsubroutine
subroutine help()
use mpi_setup
use mykind
implicit none
write(6,'(A)')" "
write(6,'(A)')" "
write(6,'(A)')" **** PROGRAM INSTRUCTION ***"
write(6,'(A)')" "
write(6,'(A)')" "
write(6,'(A)')"*NOTE1 The x,y,z components of each G value are given"
write(6,'(A)')" in terms of the ig values and the components "
write(6,'(A)')" of the recip. lattice vectors according to:"
write(6,'(A)')" ig1*b1_x + ig2*b2_x + ig3*b3_x,"
write(6,'(A)')" ig1*b1_y + ig2*b2_y + ig3*b3_y, and"
write(6,'(A)')" ig1*b1_z + ig2*b2_z + ig3*b3_z, respectively, with"
write(6,'(A)')" ig1=ig(1,iplane),"
write(6,'(A)')" ig2=ig(2,iplane), and"
write(6,'(A)')" ig3=ig(3,iplane),"
write(6,'(A)')" where iplane=1,2,...,nplane(k,ispin) is an "
write(6,'(A)')" index incrementing the plane waves for specific"
write(6,'(A)')" k and spin values"
write(6,'(A)')" "
write(6,'(A)')"*NOTE2 The energy eigenvalues are complex, as provided"
write(6,'(A)')" in the WAVECAR file, but the imaginary part is "
write(6,'(A)')" zero (at least for cases investigated thus far)"
write(6,'(A)')" "
write(6,'(A)')" ### POSSIBLE OPTIONS ###"
write(6,'(A)')" -wf filename : File name of WAVECAR to be read. Default: ./WAVECAR"
write(6,'(A)')" -path folder_in : Folder where the input/output will be read/written. Default: ./"
write(6,'(A)')" -path_out folder : Folder where the output will be written. Default: folder_in (-path)"
write(6,'(A)')" -s 2 or 1 : for the noncollinear case, -s 2"
write(6,'(A)')" : for the collinear or NM, -s 1"
write(6,'(A)')" : Default : 2 if ISPIN 1, 1 if ISPIN 2"
write(6,'(A)')" -soc : equivalent to '-s 2' "
write(6,'(A)')" -nosoc : equivalent to '-s 1' "
write(6,'(A)')" -t : Title for the system "
write(6,'(A)')" : The output will be written 'title'.dat in general"
write(6,'(A)')" : Default : 'VASPBAUM' "
write(6,'(A)')" -norm T/F : Whether normalize wavefunction. "
write(6,'(A)')" : Note: It is not orthogonal due to the PAW approach"
write(6,'(A)')" -nkdiv nkdiv : Number of k division between each KPATH"
write(6,'(A)')" -ne ne : Specify total number of electrons. "
write(6,'(A)')" : If not specified, total number of electrons will be"
write(6,'(A)')" : estimated by adding up occupations at each k-point."
write(6,'(A)')" : However, for semimetallic system, ne is differ for"
write(6,'(A)')" : each k-points, so need to specify explicitly."
write(6,'(A)')" -ii(if) ni(nf) : Specify eigenvalue index ranges from ni-th to nf-th states"
write(6,'(A)')" : unless '-cd' is not 1."
write(6,'(A)')" : Default -cd 0 -> -ii 1 -if VBM "
write(6,'(A)')" : -cd 1 -> -ii VBM -if CBM"
write(6,'(A)')" -is n : if specified, 'ni' and 'nf' will be set equal, "
write(6,'(A)')" : and only this single band will be computed."
write(6,'(A)')" -unfold : Unfold band structure."
write(6,'(A)')" : Usage: Before using this tag, you should have following files"
write(6,'(A)')" : 1. Prepare POSCAR_PC : primitive cell POSCAR to be projected"
write(6,'(A)')" : 2. Prepare POSCAR_SC : supercell POSCAR to be unfolded "
write(6,'(A)')" : 3. Prepare KPOINTS_PC : k-path of primitive BZ to be projected"
write(6,'(A)')" : Note: before run with this tag, you should have WAVECAR which is"
write(6,'(A)')" : calculated with KPOINTS_SC (copied to KPOINTS for the actual run)"
write(6,'(A)')" : and generated by -set_unfold option."
write(6,'(A)')" -ef e_fermi : Fermi level, used in unfolding procedures. Energy shift by -e_fermi"
write(6,'(A)')" -set_unfold : Prepare KPOINTS for the unfolding"
write(6,'(A)')" : Usage: Before using this tag, you should have following files"
write(6,'(A)')" : 1. Prepare POSCAR_PC : primitive cell POSCAR to be projected"
write(6,'(A)')" : 2. Prepare POSCAR_SC : supercell POSCAR to be unfolded "
write(6,'(A)')" : 3. Prepare KPOINTS_PC : k-path of primitive BZ to be projected"
write(6,'(A)')" : Output: KPOINTS_SC file will be generated"
write(6,'(A)')" : --> copy KPOINTS_SC to KPOINTS for the calculation to get WAVECAR"
write(6,'(A)')" -no_reduce : do not remove duplicated K-point when generateing supercell KPOINTS with -set_unfold"
write(6,'(A)')" -cd 1(or 0) : Calculate spin- and k-resolved degree of circular polarization,"
write(6,'(A)')" : between valence & conduction band"
write(6,'(A)')" : If set to '1', Berry cuvature will not be evaluated."
write(6,'(A)')" : You may set -ii and -if together, defining VBM & CBM, respectively."
write(6,'(A)')" 2 : If -cd is set to 2, total spectrum w.r.t. the enery will be"
write(6,'(A)')" : evaluated. In this case, -ien and -fen tag should be set by"
write(6,'(A)')" : hand. Otherwise, default value, -ien 0 -fen 10 -nediv 1000 will"
write(6,'(A)')" : be applied. The output contains degree of circular polarization"
write(6,'(A)')" : with respect to photon energy for each k-point. Here, -sigma tag"
write(6,'(A)')" : sets a gaussian broadning factor"
write(6,'(A)')" 3 : If -cd is set to 3, total spectrum w.r.t. the energy will be"
write(6,'(A)')" : evaluated with unfolding scheme."
write(6,'(A)')" : The spectral weight with unfolded band structure file (sw_file)"
write(6,'(A)')" : also should be be provided with option -sw."
write(6,'(A)')" : For the unfolding, POSCAR_PC and POSCAR_SC file should be provided"
write(6,'(A)')" : as the process of unfolding calculation (-unfold) "
write(6,'(A)')" : Note: if -cd 2 and -unfold tag is provided together, automatically"
write(6,'(A)')" : -cd 3 is applied."
write(6,'(A)')" : Default : 0"
write(6,'(A)')" -klist kfile : kfile lists kpoint index along k-path which will be read in sequence"
write(6,'(A)')" -sw sw_file : Use sw_file generated by VaspBandUnfolding for the spectral weight"
write(6,'(A)')" -ien init_e : -ien(fen) indicates initial(final) energy window to be plotted"
write(6,'(A)')" -fen fina_e : "
write(6,'(A)')" NOTE: If the option '-unfold' is specified and -ien and -fen is not"
write(6,'(A)')" specified, init(fina)_e will be automatically set based on "
write(6,'(A)')" the energy band (min,max)"
write(6,'(A)')" -nediv ndiv : How may energy grid will be divided for the spectral weight plot"
write(6,'(A)')" -sigma sigma : Gaussian smearing (in eV)"
write(6,'(A)')" -atlist afile : 'afile' contains information for atom_projected band structure file name."
write(6,'(A)')" : Total number of atom to be highlighted, and atom indices."
write(6,'(A)')" : Note that it works with -cd 2 and 3 only."
write(6,'(A)')" : EX) in afile, it read as follows"
write(6,'(A)')" : ----------------------------------------"
write(6,'(A)')" : | DOS_atom_projected.dat # LDOS file name to be read "
write(6,'(A)')" : | 6 # total atom in system "
write(6,'(A)')" : | 3 # total atom to read "
write(6,'(A)')" : | 1 2 5 # atom indices to read"
write(6,'(A)')" *** Angle resolved CD calculations: *****************"
write(6,'(A)')" * -theta theta : angle along z-axis describing the direction of the injecting light"
write(6,'(A)')" * -phi phi : angle along x-axis describing the direction of the injecting light"
write(6,'(A)')" * Default: (theta,phi) = (0,0)"
write(6,'(A)')" * Example:"
write(6,'(A)')" * Light from z-axis(surface normal): (theta,phi) = (0.0,0.0)"
write(6,'(A)')" * Light from x-axis : (theta,phi) = (90.0,0.0)"
write(6,'(A)')" * Light from y-axis : (theta,phi) = (90.0,90.0)"
write(6,'(A)')" *****************************************************"
kill_job
return
endsubroutine