Line data Source code
1 : MODULE m_reorder
2 : #ifdef _OPENACC
3 : USE cublas
4 : #define CPP_zswap cublasZswap
5 : #define CPP_dswap cublasDswap
6 : #else
7 : #define CPP_zswap zswap
8 : #define CPP_dswap dswap
9 : #endif
10 : interface reorder
11 : module procedure reorder_real, reorder_cmplx
12 : end interface reorder
13 : CONTAINS
14 88 : subroutine forw_order(atoms, lcutm, nindxm, new_order)
15 : USE m_types
16 : IMPLICIT NONE
17 :
18 : INTEGER, INTENT(IN) :: lcutm(:), nindxm(0:, :)
19 : TYPE(t_atoms), INTENT(IN) :: atoms
20 : integer, INTENT(INOUT) :: new_order(:)
21 :
22 : INTEGER :: itype, ieq, indx1, indx2, l, n, m, info, i
23 88 : integer, allocatable :: tmp_order(:)
24 :
25 66844 : new_order = [(i, i=1, size(new_order))]
26 33378 : tmp_order = new_order
27 :
28 88 : indx1 = 0
29 88 : indx2 = 0
30 220 : DO itype = 1, atoms%ntype
31 352 : DO ieq = 1, atoms%neq(itype)
32 924 : DO l = 0, lcutm(itype)
33 4092 : DO m = -l, l
34 23210 : DO n = 1, nindxm(l, itype) - 1
35 19910 : indx1 = indx1 + 1
36 19910 : indx2 = indx2 + 1
37 23210 : new_order(indx1) = tmp_order(indx2)
38 : END DO
39 3960 : indx2 = indx2 + 1
40 : END DO
41 : END DO
42 : END DO
43 : END DO
44 :
45 : indx2 = 0
46 220 : DO itype = 1, atoms%ntype
47 352 : DO ieq = 1, atoms%neq(itype)
48 924 : DO l = 0, lcutm(itype)
49 4092 : DO m = -l, l
50 3300 : indx1 = indx1 + 1
51 3300 : indx2 = indx2 + nindxm(l, itype)
52 3960 : new_order(indx1) = tmp_order(indx2)
53 : END DO
54 : END DO
55 : END DO
56 : END DO
57 88 : end subroutine forw_order
58 :
59 88 : subroutine back_order(atoms, lcutm, nindxm, new_order)
60 : use m_types
61 : use m_judft
62 : implicit none
63 : INTEGER, INTENT(IN) :: lcutm(:), nindxm(0:, :)
64 : TYPE(t_atoms), INTENT(IN) :: atoms
65 : integer, INTENT(INOUT) :: new_order(:)
66 :
67 : INTEGER :: itype, ieq, indx1, indx2, l, n, m, info, i
68 :
69 88 : integer, allocatable :: tmp_order(:)
70 :
71 66844 : new_order = [(i, i=1, size(new_order))]
72 33378 : tmp_order = new_order
73 :
74 88 : indx1 = 0
75 88 : indx2 = 0
76 220 : DO itype = 1, atoms%ntype
77 352 : DO ieq = 1, atoms%neq(itype)
78 924 : DO l = 0, lcutm(itype)
79 4092 : DO m = -l, l
80 23210 : DO n = 1, nindxm(l, itype) - 1
81 19910 : indx1 = indx1 + 1
82 19910 : indx2 = indx2 + 1
83 23210 : new_order(indx2) = tmp_order(indx1)
84 : END DO
85 3960 : indx2 = indx2 + 1
86 : END DO
87 : END DO
88 : END DO
89 : END DO
90 :
91 : indx2 = 0
92 220 : DO itype = 1, atoms%ntype
93 352 : DO ieq = 1, atoms%neq(itype)
94 924 : DO l = 0, lcutm(itype)
95 4092 : DO m = -l, l
96 3300 : indx1 = indx1 + 1
97 3300 : indx2 = indx2 + nindxm(l, itype)
98 3960 : new_order(indx2) = tmp_order(indx1)
99 : END DO
100 : END DO
101 : END DO
102 : END DO
103 88 : end subroutine back_order
104 :
105 198 : subroutine reorder_real(target_order, mat)
106 : implicit NONE
107 : integer, intent(in) :: target_order(:)
108 : REAL, INTENT(INOUT) :: mat(:,:)
109 :
110 198 : integer, allocatable :: curr_order(:)
111 : integer :: i_tmp, i, j, sz_mat_1, sz_mat_2
112 : real :: r_tmp
113 :
114 198 : sz_mat_1 = size(mat,1)
115 198 : sz_mat_2 = size(mat,2)
116 198162 : curr_order = [(i, i=1, size(target_order))]
117 :
118 66054 : do i = 1,size(mat, 1)
119 66054 : if(curr_order(i) /= target_order(i)) then
120 42900 : j = i + 1
121 3050498 : do while(target_order(i) /= curr_order(j))
122 3007598 : j = j + 1
123 : enddo
124 :
125 42900 : i_tmp = curr_order(i)
126 42900 : curr_order(i) = curr_order(j)
127 42900 : curr_order(j) = i_tmp
128 :
129 : !$acc host_data use_device(mat)
130 42900 : call CPP_dswap(sz_mat_2, mat(i,1), sz_mat_1, mat(j,1), sz_mat_1)
131 : !$acc end host_data
132 : endif
133 : enddo
134 198 : end subroutine reorder_real
135 :
136 66 : subroutine reorder_cmplx(target_order, mat)
137 : implicit NONE
138 : integer, intent(in) :: target_order(:)
139 : complex, INTENT(INOUT) :: mat(:,:)
140 :
141 66 : integer, allocatable :: curr_order(:)
142 : integer :: i_tmp, i, j, sz_mat_1, sz_mat_2
143 : complex :: r_tmp
144 :
145 66 : sz_mat_1 = size(mat,1)
146 66 : sz_mat_2 = size(mat,2)
147 102240 : curr_order = [(i, i=1, size(target_order))]
148 :
149 34080 : do i = 1,size(mat,1)
150 34080 : if(curr_order(i) /= target_order(i)) then
151 22704 : j = i + 1
152 2317612 : do while(target_order(i) /= curr_order(j))
153 2294908 : j = j + 1
154 : enddo
155 :
156 22704 : i_tmp = curr_order(i)
157 22704 : curr_order(i) = curr_order(j)
158 22704 : curr_order(j) = i_tmp
159 :
160 : !$acc host_data use_device(mat)
161 22704 : call CPP_zswap(size(mat,2), mat(i,1), sz_mat_1, mat(j,1), sz_mat_1)
162 : !$acc end host_data
163 : endif
164 : enddo
165 66 : end subroutine reorder_cmplx
166 : END MODULE
|
