File: readgamma.f90

package info (click to toggle)
elkcode 5.4.24-2
  • links: PTS, VCS
  • area: main
  • in suites: buster, sid
  • size: 12,840 kB
  • sloc: f90: 48,415; fortran: 22,457; perl: 965; makefile: 384; sh: 369; python: 105; ansic: 67
file content (84 lines) | stat: -rw-r--r-- 2,071 bytes parent folder | download
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

! 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.ne.natmtot_) then
  write(*,*)
  write(*,'("Error(readgamma): differing natmtot")')
  write(*,'(" current    : ",I4)') natmtot
  write(*,'(" GAMMAQ.OUT : ",I4)') natmtot_
  write(*,*)
  stop
end if
read(50,*) nqpt_
if (nqpt.ne.nqpt_) then
  write(*,*)
  write(*,'("Error(readgamma): differing nqpt")')
  write(*,'(" current    : ",I6)') nqpt
  write(*,'(" GAMMAQ.OUT : ",I6)') nqpt_
  write(*,*)
  stop
end if
read(50,*)
do iq=1,nqpt
  read(50,*) iq_
  if (iq.ne.iq_) then
    write(*,*)
    write(*,'("Error(readgamma): incorrect q-point index in GAMMAQ.OUT for &
     &q-point ",I6)') iq
    write(*,*)
    stop
  end if
  read(50,*) vql_
  t1=sum(abs(vql(:,iq)-vql_(:)))
  if (t1.gt.epslat) then
    write(*,*)
    write(*,'("Error(readgamma): differing q-vectors in lattice coordinates &
     &for q-point ",I6)') 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.gt.epslat) then
    write(*,*)
    write(*,'("Error(readgamma): differing q-vectors in Cartesian coordinates &
     &for q-point ",I6)') 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.ne.i_) then
      write(*,*)
      write(*,'("Error(readgamma): incorrect mode index in GAMMAQ.OUT for &
       &q-point ",I6)') iq
      write(*,*)
      stop
    end if
  end do
  read(50,*)
end do
close(50)
return
stop
end subroutine