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
|
! Copyright (C) 2008 J. K. Dewhurst, S. Sharma and C. Ambrosch-Draxl.
! This file is distributed under the terms of the GNU General Public License.
! See the file COPYING for license details.
subroutine readgamma(gq)
use modmain
use modphonon
implicit none
! arguments
real(8), intent(out) :: gq(nbph,nqpt)
! local variables
integer iq,i
integer natmtot_,nqpt_,iq_,i_
real(8) vql_(3),vqc_(3),t1
open(50,file='GAMMAQ.OUT',form='FORMATTED',status='OLD')
read(50,*)
read(50,*) natmtot_
if (natmtot /= natmtot_) then
write(*,*)
write(*,'("Error(readgamma): differing natmtot")')
write(*,'(" current : ",I0)') natmtot
write(*,'(" GAMMAQ.OUT : ",I0)') natmtot_
write(*,*)
stop
end if
read(50,*) nqpt_
if (nqpt /= nqpt_) then
write(*,*)
write(*,'("Error(readgamma): differing nqpt")')
write(*,'(" current : ",I0)') nqpt
write(*,'(" GAMMAQ.OUT : ",I0)') nqpt_
write(*,*)
stop
end if
read(50,*)
do iq=1,nqpt
read(50,*) iq_
if (iq /= iq_) then
write(*,*)
write(*,'("Error(readgamma): incorrect q-point index in GAMMAQ.OUT for &
&q-point ",I0)') iq
write(*,*)
stop
end if
read(50,*) vql_
t1=sum(abs(vql(:,iq)-vql_(:)))
if (t1 > epslat) then
write(*,*)
write(*,'("Error(readgamma): differing q-vectors in lattice coordinates &
&for q-point ",I0)') iq
write(*,'(" current : ",3G18.10)') vql(:,iq)
write(*,'(" GAMMAQ.OUT : ",3G18.10)') vql_
write(*,*)
stop
end if
read(50,*) vqc_
t1=sum(abs(vqc(:,iq)-vqc_(:)))
if (t1 > epslat) then
write(*,*)
write(*,'("Error(readgamma): differing q-vectors in Cartesian coordinates &
&for q-point ",I0)') iq
write(*,'(" current : ",3G18.10)') vqc(:,iq)
write(*,'(" GAMMAQ.OUT : ",3G18.10)') vqc_
write(*,*)
stop
end if
do i=1,nbph
read(50,*) i_,gq(i,iq)
if (i /= i_) then
write(*,*)
write(*,'("Error(readgamma): incorrect mode index in GAMMAQ.OUT for &
&q-point ",I0)') iq
write(*,*)
stop
end if
end do
read(50,*)
end do
close(50)
end subroutine
|
