-
Notifications
You must be signed in to change notification settings - Fork 3
/
write_result_sw.f90
103 lines (82 loc) · 2.92 KB
/
write_result_sw.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
#include "alias.inc"
subroutine write_result_spectral_weight(WAVEC, PINPT, PGEOM)
use parameters
use utils
use mpi_setup
implicit none
type(incar ) :: PINPT
type(eigen ) :: WAVEC
type(poscar ) :: PGEOM
character(len=256) fname
integer(kind=sp) ie, je, ik, is
integer(kind=sp) pid
character(len=20) ie_str, je_str, ik_str, is_str
integer(kind=sp) max_ik(1), min_ik(1)
real(kind=dp) max_sw, min_sw
real(kind=dp) kline(PGEOM%nkpts)
real(kind=dp) SW(PINPT%nband, PINPT%ispin, PGEOM%nkpts)
if(myid .ne. 0) return
pid = pid_output
ie = PINPT%ie_init
je = PINPT%ie_fina
ie_str = int2str(ie)
je_str = int2str(je)
kline = 0d0
call get_kline_dist(PGEOM%kpts_cart, PGEOM%nkpts, kline)
do is = 1, PINPT%ispin
is_str = int2str(is-1)
write(fname,*)trim(PINPT%folder_out)//'sw_spin',trim(adjustl(is_str)),'.dat'
open(pid, file=trim(fname), status='unknown')
do ie = 1, PINPT%nband
write(pid,'(A,I0,A)')'# KPATH(A^-1) ENERGY(eV) SW : ', ie, ' -th eigenvalue'
do ik = 1, PGEOM%nkpts
write(pid,'(F11.6,2F15.6)')kline(ik),WAVEC%E(ie,is,PGEOM%ikpt(ik)),WAVEC%SW_BAND(ie,is,ik)
enddo
write(pid,'(A)')' '
write(pid,'(A)')' '
enddo
close(pid)
enddo
return
endsubroutine
subroutine write_spectral_function(WAVEC, PINPT, PGEOM)
use parameters
use utils
use mpi_setup
implicit none
type(incar ) :: PINPT
type(eigen ) :: WAVEC
type(poscar ) :: PGEOM
character(len=256) fname
integer(kind=sp) ii
integer(kind=sp) ie, je, ik, is
integer(kind=sp) pid
integer(kind=sp) nediv
character(len=20) ie_str, je_str, ik_str, is_str
integer(kind=sp) max_ik(1), min_ik(1)
real(kind=dp) max_sw, min_sw
real(kind=dp) kline(PGEOM%nkpts), erange(PINPT%nediv)
if(myid .ne. 0) return
nediv = PINPT%nediv
erange = PINPT%init_e + eta + &
dble((/(ii,ii=0,nediv-1)/))*(PINPT%fina_e-PINPT%init_e)/dble(nediv-1)
call get_kline_dist(PGEOM%kpts_cart, PGEOM%nkpts, kline)
do is = 1, PINPT%ispin
is_str = int2str(is-1)
write(fname,*)trim(PINPT%folder_out)//'SW.SPIN',trim(adjustl(is_str)),'.dat'
open(pid, file=trim(fname), status='unknown')
do ik = 1, PGEOM%nline+1
write(pid,'(A,I6,A, F10.5)')'# K SEGMENTS ',ik, ' : ', kline(PGEOM%k_name_index(ik))
enddo
do ik = 1, PGEOM%nkpts
write(pid,'(A)')'# KPATH ENERGY SW '
do ie = 1, nediv
write(pid,'(3F16.8)') kline(ik), erange(ie) , WAVEC%SW(1, ie, is, ik)
enddo
write(pid,'(A)')' '
write(pid,'(A)')' '
enddo
close(pid)
enddo
return
endsubroutine