-
Notifications
You must be signed in to change notification settings - Fork 22
/
Copy pathcryst_to_car.f90
152 lines (151 loc) · 5.12 KB
/
cryst_to_car.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
!
! Copyright (C) 2001-2003 PWSCF group
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt .
!
!
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
subroutine cryst_to_cart (nvec, vec, trmat, iflag)
!-----------------------------------------------------------------------
!
! This routine transforms the atomic positions or the k-point
! components from crystallographic to cartesian coordinates
! ( iflag=1 ) and viceversa ( iflag=-1 ).
! Output cartesian coordinates are stored in the input ('vec') array
!
!
USE kinds, ONLY : DP
implicit none
!
integer, intent(in) :: nvec, iflag
! nvec: number of vectors (atomic positions or k-points)
! to be transformed from crystal to cartesian and vice versa
! iflag: gives the direction of the transformation
real(DP), intent(in) :: trmat (3, 3)
! trmat: transformation matrix
! if iflag=1:
! trmat = at , basis of the real-space lattice, for atoms or
! = bg , basis of the reciprocal-space lattice, for k-points
! if iflag=-1: the opposite
real(DP), intent(inout) :: vec (3, nvec)
! coordinates of the vector (atomic positions or k-points) to be
! transformed - overwritten on output
!
! local variables
!
integer :: nv, kpol
! counter on vectors
! counter on polarizations
real(DP) :: vau (3)
! workspace
!
! Compute the cartesian coordinates of each vectors
! (atomic positions or k-points components)
!
do nv = 1, nvec
if (iflag.eq.1) then
do kpol = 1, 3
vau (kpol) = trmat (kpol, 1) * vec (1, nv) + trmat (kpol, 2) &
* vec (2, nv) + trmat (kpol, 3) * vec (3, nv)
enddo
else
do kpol = 1, 3
vau (kpol) = trmat (1, kpol) * vec (1, nv) + trmat (2, kpol) &
* vec (2, nv) + trmat (3, kpol) * vec (3, nv)
enddo
endif
do kpol = 1, 3
vec (kpol, nv) = vau (kpol)
enddo
enddo
!
return
end subroutine cryst_to_cart
#ifdef USE_CUDA
subroutine cryst_to_cart_gpu (nvec, vec, trmat, iflag)
!-----------------------------------------------------------------------
!
! This routine transforms the atomic positions or the k-point
! components from crystallographic to cartesian coordinates
! ( iflag=1 ) and viceversa ( iflag=-1 ).
! Output cartesian coordinates are stored in the input ('vec') array
!
!
USE kinds, ONLY : DP
implicit none
!
integer, intent(in) :: nvec, iflag
! nvec: number of vectors (atomic positions or k-points)
! to be transformed from crystal to cartesian and vice versa
! iflag: gives the direction of the transformation
real(DP), intent(in),device :: trmat (3, 3)
! trmat: transformation matrix
! if iflag=1:
! trmat = at , basis of the real-space lattice, for atoms or
! = bg , basis of the reciprocal-space lattice, for k-points
! if iflag=-1: the opposite
real(DP), intent(inout),device :: vec (3, nvec)
! coordinates of the vector (atomic positions or k-points) to be
! transformed - overwritten on output
!
! local variables
!
integer :: nv, kpol
! counter on vectors
! counter on polarizations
real(DP),device :: vau (3)
! workspace
!
! Compute the cartesian coordinates of each vectors
! (atomic positions or k-points components)
!
!do nv = 1, nvec
! if (iflag.eq.1) then
! do kpol = 1, 3
! vau (kpol) = trmat (kpol, 1) * vec (1, nv) + trmat (kpol, 2) &
! * vec (2, nv) + trmat (kpol, 3) * vec (3, nv)
! enddo
! else
! do kpol = 1, 3
! vau (kpol) = trmat (1, kpol) * vec (1, nv) + trmat (2, kpol) &
! * vec (2, nv) + trmat (3, kpol) * vec (3, nv)
! enddo
! endif
! do kpol = 1, 3
! vec (kpol, nv) = vau (kpol)
! enddo
!enddo
if (iflag.eq.1) then
!$cuf kernel do(1) <<<*,*>>>
do nv = 1, nvec
vau (1) = trmat (1, 1) * vec (1, nv) + trmat (1, 2) &
* vec (2, nv) + trmat (1, 3) * vec (3, nv)
vau (2) = trmat (2, 1) * vec (1, nv) + trmat (2, 2) &
* vec (2, nv) + trmat (2, 3) * vec (3, nv)
vau (3) = trmat (3, 1) * vec (1, nv) + trmat (3, 2) &
* vec (2, nv) + trmat (3, 3) * vec (3, nv)
vec (1, nv) = vau (1)
vec (2, nv) = vau (2)
vec (3, nv) = vau (3)
enddo
else
!$cuf kernel do(1) <<<*,*>>>
do nv = 1, nvec
vau (1) = trmat (1, 1) * vec (1, nv) + trmat (2, 1) &
* vec (2, nv) + trmat (3, 1) * vec (3, nv)
vau (2) = trmat (1, 2) * vec (1, nv) + trmat (2, 2) &
* vec (2, nv) + trmat (3, 2) * vec (3, nv)
vau (3) = trmat (1, 3) * vec (1, nv) + trmat (2, 3) &
* vec (2, nv) + trmat (3, 3) * vec (3, nv)
vec (1, nv) = vau (1)
vec (2, nv) = vau (2)
vec (3, nv) = vau (3)
enddo
endif
!
return
end subroutine cryst_to_cart_gpu
#endif