Branch data Line data Source code
1 : : !!****m* ABINIT/m_slc_primitive_potential
2 : : !! NAME
3 : : !! m_slc_primitive_potential
4 : : !!
5 : : !! FUNCTION
6 : : !! This module contains the atomic structures and the spin-lattice coupling terms inside the primitive cell
7 : : !! which can be directly mapped to the netcdf file. It is not for the calculation, but for constructing
8 : : !! the hamiltonian in supercell.
9 : : !!
10 : : !! Datatypes:
11 : : !! slc_primitive_potential_t
12 : : !!
13 : : !! Subroutines:
14 : : !!
15 : : !! COPYRIGHT
16 : : !! Copyright (C) 2001-2026 ABINIT group (hexu,nehelbig)
17 : : !! This file is distributed under the terms of the
18 : : !! GNU General Public License, see ~abinit/COPYING
19 : : !! or http://www.gnu.org/copyleft/gpl.txt .
20 : : !! For the initials of contributors, see ~abinit/doc/developers/contributors.txt .
21 : : !!
22 : : !! SOURCE
23 : :
24 : : #if defined HAVE_CONFIG_H
25 : : #include "config.h"
26 : : #endif
27 : : #include "abi_common.h"
28 : :
29 : : module m_slc_primitive_potential
30 : :
31 : : use m_nctk
32 : : #if defined HAVE_NETCDF
33 : : use netcdf
34 : : #endif
35 : : use m_abicore
36 : : use defs_basis
37 : : use m_errors
38 : :
39 : : use m_slc_potential
40 : : use m_spmat_ndcoo
41 : :
42 : : use m_abstract_potential, only: abstract_potential_t
43 : : use m_dynamic_array, only: int2d_array_type
44 : : use m_mpi_scheduler, only: init_mpi_info
45 : : use m_multibinit_cell, only: mbcell_t, mbsupercell_t
46 : : use m_multibinit_dataset, only: multibinit_dtset_type
47 : : use m_primitive_potential, only: primitive_potential_t
48 : :
49 : : use m_supercell_maker, only: supercell_maker_t
50 : : use m_xmpi
51 : :
52 : : implicit none
53 : :
54 : : type, public, extends(primitive_potential_t) :: slc_primitive_potential_t
55 : : integer :: natom, nspin ! on every mpi node
56 : : logical :: has_bilin=.False. ! bilinear coupling term, i.e. liu
57 : : logical :: has_linquad=.False. ! spin first then lattice, i.e. niuv
58 : : logical :: has_quadlin=.False. ! spin first then lattice, i.e. oiju
59 : : logical :: has_biquad=.False. ! biquadratic coupling term, i.e. tijuv
60 : :
61 : : !four possible coupling terms, bilinear, quadratic-linear, linear-quadratic, and biquadratic
62 : : !all the following are only on master node
63 : : type(ndcoo_mat_t) :: liu ! parameter values
64 : : type(ndcoo_mat_t) :: niuv ! parameter values
65 : : type(ndcoo_mat_t) :: oiju ! parameter values
66 : : type(ndcoo_mat_t) :: tijuv ! parameter values
67 : : !R vector of i index is always zero
68 : : type(int2d_array_type) :: lRulist ! R vector for u index of liu
69 : : type(int2d_array_type) :: nRulist ! R vector for u index of niuv
70 : : type(int2d_array_type) :: nRvlist ! R vector for v index of niuv
71 : : type(int2d_array_type) :: oRjlist ! R vector for j index of oiju
72 : : type(int2d_array_type) :: oRulist ! R vector for u index of oiju
73 : : type(int2d_array_type) :: tRjlist ! R vector for j index of tijuv
74 : : type(int2d_array_type) :: tRulist ! R vector for u index of tijuv
75 : : type(int2d_array_type) :: tRvlist ! R vector for v index of tijuv
76 : :
77 : : contains
78 : : procedure:: initialize
79 : : procedure:: finalize
80 : : procedure :: set_liu
81 : : procedure :: set_liu_1term
82 : : procedure :: set_niuv
83 : : procedure :: set_niuv_1term
84 : : procedure :: set_oiju
85 : : procedure :: set_oiju_1term
86 : : procedure :: set_tijuv
87 : : procedure :: set_tijuv_1term
88 : : procedure :: load_from_files
89 : : procedure :: read_netcdf
90 : : procedure :: read_liu
91 : : procedure :: read_niuv
92 : : procedure :: read_oiju
93 : : procedure :: read_tijuv
94 : : procedure :: fill_supercell
95 : : procedure :: fill_liu
96 : : procedure :: fill_niuv
97 : : procedure :: fill_oiju
98 : : procedure :: fill_tijuv
99 : : procedure :: set_liu_sc
100 : : procedure :: set_niuv_sc
101 : : procedure :: set_oiju_sc
102 : : procedure :: set_tijuv_sc
103 : : end type slc_primitive_potential_t
104 : :
105 : : contains
106 : :
107 : 2 : subroutine initialize(self, primcell)
108 : : class(slc_primitive_potential_t), intent(inout) :: self
109 : : type(mbcell_t), target, intent(inout) :: primcell
110 : : !integer, intent(in) :: nspin
111 : 2 : self%primcell=>primcell
112 : 2 : self%label="SLC_primitive_potential"
113 : 2 : self%has_spin=.True.
114 : 2 : self%has_displacement=.True.
115 : 2 : self%has_strain=.False.
116 : 2 : self%has_lwf=.False.
117 : 2 : end subroutine initialize
118 : :
119 : :
120 : 2 : subroutine finalize(self)
121 : : class(slc_primitive_potential_t), intent(inout) :: self
122 : 2 : call self%oiju%finalize()
123 : 2 : call self%oRjlist%finalize()
124 : 2 : call self%oRulist%finalize()
125 : 2 : call self%tijuv%finalize()
126 : 2 : call self%tRjlist%finalize()
127 : 2 : call self%tRulist%finalize()
128 : 2 : call self%tRvlist%finalize()
129 : 2 : nullify(self%primcell)
130 : 2 : self%nspin=0
131 : 2 : self%natom=0
132 : 2 : self%label="Destroyed SLC_primitive_potential"
133 : 2 : call self%primitive_potential_t%finalize()
134 : 2 : end subroutine finalize
135 : :
136 : 2 : subroutine load_from_files(self, params, fnames)
137 : : class(slc_primitive_potential_t), intent(inout) :: self
138 : : type(multibinit_dtset_type), intent(in) :: params
139 : : character(len=fnlen), intent(in) :: fnames(:)
140 : : character(len=fnlen) :: ncdf_fname
141 : : character(len=500) :: message
142 : : integer :: ii
143 : : ABI_UNUSED(fnames)
144 [ + - ]: 2 : if (xmpi_comm_rank(xmpi_world)==0) then
145 : 2 : ncdf_fname=params%slc_pot_fname
146 [ + + ]: 164 : write(message,'(a,(81a, 80a),3a)') ch10,('=',ii=1,80),ch10,ch10,&
147 [ + - ]: 166 : & '- Reading spin-lattice coupling terms from ', trim(ncdf_fname)
148 : 2 : call wrtout(ab_out,message,'COLL')
149 : 2 : call wrtout(std_out,message,'COLL')
150 : : endif
151 [ + - ]: 2 : call self%read_netcdf(trim(ncdf_fname)//char(0))
152 : :
153 : 2 : ABI_UNUSED_A(params)
154 : 2 : end subroutine load_from_files
155 : :
156 : : !-----------------------------------
157 : : ! reading parameters from ncdf file
158 : : !-----------------------------------
159 : 2 : subroutine read_netcdf(self, ncdf_fname)
160 : : class(slc_primitive_potential_t), intent(inout) :: self
161 : : character (len = *), intent(in) :: ncdf_fname
162 : :
163 : : integer:: ncid, ncerr, comm
164 : :
165 : : #if defined HAVE_NETCDF
166 : :
167 : 2 : comm = xmpi_world
168 : :
169 : 2 : ncerr = nctk_open_read(ncid, ncdf_fname, comm)
170 : :
171 : : ! read primcell info
172 : 2 : ncerr=nctk_get_dim(ncid, "natom", self%natom)
173 : 2 : ncerr=nctk_get_dim(ncid, "nspin", self%nspin)
174 : :
175 : : ! read different coupling terms if they are present in the file
176 : 2 : call self%read_liu(ncid)
177 : 2 : call self%read_niuv(ncid)
178 : 2 : call self%read_oiju(ncid)
179 : 2 : call self%read_tijuv(ncid)
180 : :
181 : 2 : ncerr = nf90_close(ncid)
182 [ - + ]: 2 : if(ncerr /= NF90_NOERR) then
183 : 0 : write(std_out,'(A25)') 'Could not close netcdf file'
184 : : endif
185 : : #else
186 : : ABI_ERROR("Multibint should be installed with netcdf enabled to run this.")
187 : :
188 : : #endif
189 : :
190 : 2 : end subroutine read_netcdf
191 : :
192 : : !---------------------------------------
193 : : ! reading liu parameters from ncdf file
194 : : ! TODO: test
195 : : !---------------------------------------
196 : 2 : subroutine read_liu(self, ncid)
197 : : class(slc_primitive_potential_t), intent(inout) :: self
198 : : integer, intent(in) :: ncid
199 : :
200 : : integer :: ncerr, dimid, ndata, varid
201 : 2 : integer, allocatable :: ilist(:), ulist(:,:)
202 : 2 : real(dp), allocatable :: vallist(:)
203 : : #if defined HAVE_NETCDF
204 : :
205 : 2 : ncerr = nf90_inq_dimid(ncid, "spin_lattice_Liu_number_of_entries", dimid)
206 [ + - ]: 2 : if(ncerr /= NF90_NOERR) then
207 : 2 : ndata = 0
208 : : else
209 : 0 : self%has_bilin=.True.
210 : 0 : ncerr = nctk_get_dim(ncid, "spin_lattice_Liu_number_of_entries", ndata)
211 [ # # # # : 0 : ABI_MALLOC(ilist, (ndata))
# # # # #
# # # ]
212 [ # # # # : 0 : ABI_MALLOC(ulist, (4,ndata))
# # # # #
# # # ]
213 [ # # # # : 0 : ABI_MALLOC(vallist, (ndata))
# # # # #
# # # ]
214 : :
215 : 0 : varid = nctk_idname(ncid, "spin_lattice_Liu_ilist")
216 : 0 : ncerr = nf90_get_var(ncid, varid, ilist)
217 : 0 : call netcdf_check(ncerr, "when reading Liu_ilist")
218 : :
219 : 0 : varid = nctk_idname(ncid, "spin_lattice_Liu_ulist")
220 : 0 : ncerr = nf90_get_var(ncid, varid, ulist)
221 : 0 : call netcdf_check(ncerr, "when reading Liu_ulist")
222 : :
223 : 0 : varid = nctk_idname(ncid, "spin_lattice_Liu_valuelist")
224 : 0 : ncerr = nf90_get_var(ncid, varid, vallist)
225 : 0 : call netcdf_check(ncerr, "when reading Liu_valuelist")
226 : :
227 : : !change units from eV to Ha and Ang to Bohr
228 [ # # ]: 0 : vallist(:) = vallist(:)*eV_Ha*Bohr_Ang
229 : :
230 : : !fill the sparse matrix for liu parameters
231 : 0 : call self%set_liu(ndata, ilist, ulist, vallist)
232 : :
233 [ # # ]: 0 : ABI_SFREE(ilist)
234 [ # # ]: 0 : ABI_SFREE(ulist)
235 [ # # ]: 0 : ABI_SFREE(vallist)
236 : : endif
237 : :
238 : 2 : write(std_out,'(A8,I10,A11)') 'L_iu: ', ndata, 'terms read'
239 : : #else
240 : : ABI_ERROR("Multibinit should be installed with netcdf.")
241 : : #endif
242 : :
243 [ - + - + : 2 : end subroutine read_liu
- + ]
244 : :
245 : : !----------------------------------------
246 : : ! reading niuv parameters from ncdf file
247 : : ! TODO: test
248 : : !----------------------------------------
249 : 2 : subroutine read_niuv(self, ncid)
250 : : class(slc_primitive_potential_t), intent(inout) :: self
251 : : integer, intent(in) :: ncid
252 : :
253 : : integer :: ncerr, dimid, ndata, varid
254 : 2 : integer, allocatable :: ilist(:), ulist(:,:), vlist(:,:)
255 : 2 : real(dp), allocatable :: vallist(:)
256 : : #if defined HAVE_NETCDF
257 : 2 : ncerr = nf90_inq_dimid(ncid, "spin_lattice_Niuv_number_of_entries", dimid)
258 [ + - ]: 2 : if(ncerr /= NF90_NOERR) then
259 : 2 : ndata = 0
260 : : else
261 : 0 : self%has_linquad=.True.
262 : 0 : ncerr = nctk_get_dim(ncid, "spin_lattice_Niuv_number_of_entries", ndata)
263 [ # # # # : 0 : ABI_MALLOC(ilist, (ndata))
# # # # #
# # # ]
264 [ # # # # : 0 : ABI_MALLOC(ulist, (4,ndata))
# # # # #
# # # ]
265 [ # # # # : 0 : ABI_MALLOC(vlist, (4,ndata))
# # # # ]
266 [ # # # # : 0 : ABI_MALLOC(vallist, (ndata))
# # # # #
# # # ]
267 : :
268 : 0 : varid = nctk_idname(ncid, "spin_lattice_Niuv_ilist")
269 : 0 : ncerr = nf90_get_var(ncid, varid, ilist)
270 : 0 : call netcdf_check(ncerr, "when reading Niuv_ilist")
271 : :
272 : 0 : varid = nctk_idname(ncid, "spin_lattice_Niuv_ulist")
273 : 0 : ncerr = nf90_get_var(ncid, varid, ulist)
274 : 0 : call netcdf_check(ncerr, "when reading Niuv_ulist")
275 : :
276 : 0 : varid = nctk_idname(ncid, "spin_lattice_Niuv_vlist")
277 : 0 : ncerr = nf90_get_var(ncid, varid, ulist)
278 : 0 : call netcdf_check(ncerr, "when reading Niuv_vlist")
279 : :
280 : 0 : varid = nctk_idname(ncid, "spin_lattice_Niuv_valuelist")
281 : 0 : ncerr = nf90_get_var(ncid, varid, vallist)
282 : 0 : call netcdf_check(ncerr, "when reading Niuv_valuelist")
283 : :
284 : : !change units from eV to Ha and Ang to Bohr
285 [ # # ]: 0 : vallist(:) = vallist(:)*eV_Ha*(Bohr_Ang*Bohr_Ang)
286 : :
287 : : !fill the sparse matrix for liu parameters
288 : 0 : call self%set_niuv(ndata, ilist, ulist, vlist, vallist)
289 : :
290 [ # # ]: 0 : ABI_SFREE(ilist)
291 [ # # ]: 0 : ABI_SFREE(ulist)
292 [ # # ]: 0 : ABI_SFREE(vlist)
293 [ # # ]: 0 : ABI_SFREE(vallist)
294 : : endif
295 : :
296 : 2 : write(std_out,'(A8,I10,A11)') 'N_iuv: ', ndata, 'terms read'
297 : : #else
298 : : ABI_ERROR("Multibinit should be installed with netcdf")
299 : : #endif
300 : :
301 [ - + - + : 2 : end subroutine read_niuv
- + ]
302 : :
303 : : !---------------------------------------
304 : : ! reading oiju parameters from ncdf file
305 : : !---------------------------------------
306 : 2 : subroutine read_oiju(self, ncid)
307 : : class(slc_primitive_potential_t), intent(inout) :: self
308 : : integer, intent(in) :: ncid
309 : :
310 : : integer :: ncerr, dimid, ndata, varid
311 : 2 : integer, allocatable :: ilist(:), jlist(:,:), ulist(:,:)
312 : 2 : real(dp), allocatable :: vallist(:)
313 : :
314 : : #if defined HAVE_NETCDF
315 : 2 : ncerr = nf90_inq_dimid(ncid, "spin_lattice_Oiju_number_of_entries", dimid)
316 [ - + ]: 2 : if(ncerr /= NF90_NOERR) then
317 : 0 : write(std_out,'(A20)') 'No O_iju term found'
318 : : else
319 : 2 : self%has_quadlin=.True.
320 : 2 : ncerr = nctk_get_dim(ncid, "spin_lattice_Oiju_number_of_entries", ndata)
321 [ - + + - : 6 : ABI_MALLOC(ilist, (ndata))
+ - + - -
+ - + ]
322 [ - + + - : 6 : ABI_MALLOC(jlist, (4,ndata))
+ - + - -
+ - + ]
323 [ - + + - : 4 : ABI_MALLOC(ulist, (4,ndata))
- + - + ]
324 [ - + + - : 6 : ABI_MALLOC(vallist, (ndata))
+ - + - -
+ - + ]
325 : :
326 : 2 : varid = nctk_idname(ncid, "spin_lattice_Oiju_ilist")
327 : 2 : ncerr = nf90_get_var(ncid, varid, ilist)
328 : 2 : call netcdf_check(ncerr, "when reading Oiju_ilist")
329 : :
330 : 2 : varid = nctk_idname(ncid, "spin_lattice_Oiju_jlist")
331 : 2 : ncerr = nf90_get_var(ncid, varid, jlist)
332 : 2 : call netcdf_check(ncerr, "when reading Oiju_jlist")
333 : :
334 : 2 : varid = nctk_idname(ncid, "spin_lattice_Oiju_ulist")
335 : 2 : ncerr = nf90_get_var(ncid, varid, ulist)
336 : 2 : call netcdf_check(ncerr, "when reading Oiju_ulist")
337 : :
338 : 2 : varid = nctk_idname(ncid, "spin_lattice_Oiju_valuelist")
339 : 2 : ncerr = nf90_get_var(ncid, varid, vallist)
340 : 2 : call netcdf_check(ncerr, "when reading spin_lattice_Oiju_valuelist")
341 : :
342 : 2 : write(std_out,'(A8,I10,A11)') 'O_iju: ', ndata, 'terms read'
343 : :
344 : : !change units from eV to Ha and Ang to Bohr
345 [ + + ]: 4826 : vallist(:) = vallist(:)*eV_Ha*Bohr_Ang
346 : :
347 : : !fill the sparse matrix for oiju parameters
348 : 2 : call self%set_oiju(ndata, ilist, jlist, ulist, vallist)
349 : :
350 [ + - ]: 2 : ABI_SFREE(ilist)
351 [ + - ]: 2 : ABI_SFREE(jlist)
352 [ + - ]: 2 : ABI_SFREE(ulist)
353 [ + - ]: 2 : ABI_SFREE(vallist)
354 : : endif
355 : : #else
356 : : ABI_ERROR('Multibinit should be install with netcdf to run this.')
357 : : #endif
358 : :
359 [ - + - + : 2 : end subroutine read_oiju
- + - + ]
360 : :
361 : : !-----------------------------------------
362 : : ! reading tijuv parameters from ncdf file
363 : : !-----------------------------------------
364 : 2 : subroutine read_tijuv(self, ncid)
365 : : class(slc_primitive_potential_t), intent(inout) :: self
366 : : integer, intent(in) :: ncid
367 : :
368 : : integer :: ncerr, dimid, ndata, varid
369 : 2 : integer, allocatable :: ilist(:), jlist(:,:), ulist(:,:), vlist(:,:)
370 : 2 : real(dp), allocatable :: vallist(:)
371 : :
372 : : #if defined HAVE_NETCDF
373 : 2 : ncerr = nf90_inq_dimid(ncid, "spin_lattice_Tijuv_number_of_entries", dimid)
374 [ + - ]: 2 : if(ncerr /= NF90_NOERR) then
375 : : ndata = 0
376 : : else
377 : 2 : self%has_biquad=.True.
378 : 2 : ncerr = nctk_get_dim(ncid, "spin_lattice_Tijuv_number_of_entries", ndata)
379 [ - + + - : 6 : ABI_MALLOC(ilist, (ndata))
+ - + - -
+ - + ]
380 [ - + + - : 6 : ABI_MALLOC(jlist, (4, ndata))
+ - + - -
+ - + ]
381 [ - + + - : 4 : ABI_MALLOC(ulist, (4, ndata))
- + - + ]
382 [ - + + - : 4 : ABI_MALLOC(vlist, (4, ndata))
- + - + ]
383 [ - + + - : 6 : ABI_MALLOC(vallist, (ndata))
+ - + - -
+ - + ]
384 : :
385 : 2 : varid = nctk_idname(ncid, "spin_lattice_Tijuv_ilist")
386 : 2 : ncerr = nf90_get_var(ncid, varid, ilist)
387 : 2 : call netcdf_check(ncerr, "when reading Tijuv_ilist")
388 : :
389 : 2 : varid = nctk_idname(ncid, "spin_lattice_Tijuv_jlist")
390 : 2 : ncerr = nf90_get_var(ncid, varid, jlist)
391 : 2 : call netcdf_check(ncerr, "when reading Tijuv_jlist")
392 : :
393 : 2 : varid = nctk_idname(ncid, "spin_lattice_Tijuv_ulist")
394 : 2 : ncerr = nf90_get_var(ncid, varid, ulist)
395 : 2 : call netcdf_check(ncerr, "when reading Tijuv_ulist")
396 : :
397 : 2 : varid = nctk_idname(ncid, "spin_lattice_Tijuv_vlist")
398 : 2 : ncerr = nf90_get_var(ncid, varid, vlist)
399 : 2 : call netcdf_check(ncerr, "when reading Tijuv_vlist")
400 : :
401 : 2 : varid = nctk_idname(ncid, "spin_lattice_Tijuv_valuelist")
402 : 2 : ncerr = nf90_get_var(ncid, varid, vallist)
403 : 2 : call netcdf_check(ncerr, "when reading Tijuv_valuelist")
404 : :
405 : 2 : write(std_out,'(A8,I10,A11)') 'T_ijuv:', ndata, 'terms read'
406 : :
407 : : !change units from eV to Ha and Ang to Bohr
408 [ + + ]: 650 : vallist(:) = vallist(:)*eV_Ha*(Bohr_Ang*Bohr_Ang)
409 : :
410 : : !fill the sparse matrix for tijuv parameters
411 : 2 : call self%set_tijuv(ndata, ilist, jlist, ulist, vlist, vallist)
412 : :
413 [ + - ]: 2 : ABI_SFREE(ilist)
414 [ + - ]: 2 : ABI_SFREE(jlist)
415 [ + - ]: 2 : ABI_SFREE(ulist)
416 [ + - ]: 2 : ABI_SFREE(vlist)
417 [ + - ]: 2 : ABI_SFREE(vallist)
418 : : endif
419 : :
420 : : #else
421 : : ABI_ERROR('Multibinit should be install with netcdf to run this.')
422 : : #endif
423 : :
424 : :
425 [ - + - + : 2 : end subroutine read_tijuv
- + - + -
+ ]
426 : :
427 : : !---------------------------------------
428 : : ! store liu parameters in sparse matrix
429 : : ! TODO: test
430 : : !---------------------------------------
431 : 0 : subroutine set_liu(self, nn, ilist, ulist, vallist)
432 : :
433 : : class(slc_primitive_potential_t), intent(inout) :: self
434 : : integer, intent(inout) :: nn
435 : : integer, intent(in) :: ilist(nn)
436 : : integer, intent(in) :: ulist(4,nn)
437 : : real(dp), intent(in) :: vallist(nn)
438 : :
439 : : integer :: idx
440 : :
441 [ # # ]: 0 : call self%liu%initialize(mshape=[-1, self%nspin*3, self%natom*3])
442 : :
443 [ # # ]: 0 : if (xmpi_comm_rank(xmpi_world)==0) then
444 [ # # ]: 0 : do idx=1, nn
445 : 0 : call self%set_liu_1term(ilist(idx), ulist(1,idx), ulist(2:4,idx), vallist(idx))
446 : : end do
447 : : endif
448 : 0 : end subroutine set_liu
449 : :
450 : : !------------------------------------
451 : : ! add one entry to sparse liu matrix
452 : : ! TODO: test
453 : : !------------------------------------
454 : 0 : subroutine set_liu_1term(self, ii, uu, Ru, val)
455 : : class(slc_primitive_potential_t), intent(inout) :: self
456 : : integer, intent(in) :: ii
457 : : integer, intent(in) :: uu
458 : : integer, intent(in) :: Ru(3)
459 : : real(dp), intent(in) :: val
460 : :
461 : : integer :: indRu
462 : :
463 : 0 : call self%lRulist%push_unique(Ru, position=indRu)
464 : :
465 [ # # ]: 0 : call self%liu%add_entry(ind=[indRu, ii, uu], val=val)
466 : :
467 : 0 : end subroutine set_liu_1term
468 : :
469 : : !----------------------------------------
470 : : ! store niuv parameters in sparse matrix
471 : : ! TODO: test
472 : : !----------------------------------------
473 : 0 : subroutine set_niuv(self, nn, ilist, ulist, vlist, vallist)
474 : :
475 : : class(slc_primitive_potential_t), intent(inout) :: self
476 : : integer, intent(inout) :: nn
477 : : integer, intent(in) :: ilist(nn)
478 : : integer, intent(in) :: ulist(4,nn)
479 : : integer, intent(in) :: vlist(4,nn)
480 : : real(dp), intent(in) :: vallist(nn)
481 : :
482 : : integer :: idx
483 : :
484 [ # # ]: 0 : call self%niuv%initialize(mshape=[-1, -1, self%nspin*3, self%natom*3, self%natom*3])
485 : :
486 [ # # ]: 0 : if (xmpi_comm_rank(xmpi_world)==0) then
487 [ # # ]: 0 : do idx=1, nn
488 : 0 : call self%set_niuv_1term(ilist(idx), ulist(1,idx), vlist(1,idx), ulist(2:4,idx), vlist(2:4,idx), vallist(idx))
489 : : end do
490 : : endif
491 : :
492 : 0 : end subroutine set_niuv
493 : :
494 : : !-------------------------------------
495 : : ! add one entry to sparse niuv matrix
496 : : !-------------------------------------
497 : 0 : subroutine set_niuv_1term(self, ii, uu, vv, Ru, Rv, val)
498 : : class(slc_primitive_potential_t), intent(inout) :: self
499 : : integer, intent(in) :: ii
500 : : integer, intent(in) :: uu
501 : : integer, intent(in) :: vv
502 : : integer, intent(in) :: Ru(3)
503 : : integer, intent(in) :: Rv(3)
504 : : real(dp), intent(in) :: val
505 : :
506 : : integer :: indRu, indRv
507 : :
508 : 0 : call self%nRulist%push_unique(Ru, position=indRu)
509 : 0 : call self%nRvlist%push_unique(Rv, position=indRv)
510 : :
511 [ # # ]: 0 : call self%niuv%add_entry(ind=[indRu, indRv, ii, uu, vv], val=val)
512 : :
513 : 0 : end subroutine set_niuv_1term
514 : :
515 : :
516 : : !----------------------------------------
517 : : ! store oiju parameters in sparse matrix
518 : : ! TODO: test
519 : : !----------------------------------------
520 : 2 : subroutine set_oiju(self, nn, ilist, jlist, ulist, vallist)
521 : :
522 : : class(slc_primitive_potential_t), intent(inout) :: self
523 : : integer, intent(inout) :: nn
524 : : integer, intent(in) :: ilist(nn)
525 : : integer, intent(in) :: jlist(4,nn)
526 : : integer, intent(in) :: ulist(4,nn)
527 : : real(dp), intent(in) :: vallist(nn)
528 : :
529 : : integer :: idx
530 : :
531 [ + + ]: 12 : call self%oiju%initialize(mshape=[-1, -1, self%nspin*3, self%nspin*3, self%natom*3])
532 : :
533 [ + - ]: 2 : if (xmpi_comm_rank(xmpi_world)==0) then
534 [ + + ]: 4826 : do idx=1, nn
535 : 4826 : call self%set_oiju_1term(ilist(idx), jlist(1,idx), ulist(1,idx), jlist(2:4,idx), ulist(2:4,idx), vallist(idx))
536 : : end do
537 : : endif
538 : :
539 : 2 : call self%oiju%sum_duplicates()
540 : 2 : end subroutine set_oiju
541 : :
542 : : !-------------------------------------
543 : : ! add one entry to sparse oiju matrix
544 : : ! TODO: test
545 : : !-------------------------------------
546 : 4824 : subroutine set_oiju_1term(self, ii, jj, uu, Rj, Ru, val)
547 : : class(slc_primitive_potential_t), intent(inout) :: self
548 : : integer, intent(in) :: ii
549 : : integer, intent(in) :: jj
550 : : integer, intent(in) :: uu
551 : : integer, intent(in) :: Rj(3)
552 : : integer, intent(in) :: Ru(3)
553 : : real(dp), intent(in) :: val
554 : :
555 : : integer :: indRj, indRu
556 : :
557 : 4824 : call self%oRjlist%push_unique(Rj, position=indRj)
558 : 4824 : call self%oRulist%push_unique(Ru, position=indRu)
559 : :
560 [ + + ]: 28944 : call self%oiju%add_entry(ind=[indRj, indRu, ii, jj, uu], val=val)
561 : :
562 : 4824 : end subroutine set_oiju_1term
563 : :
564 : : !----------------------------------------
565 : : ! store tijuv parameters in sparse matrix
566 : : !----------------------------------------
567 : 2 : subroutine set_tijuv(self, nn, ilist, jlist, ulist, vlist, vallist)
568 : :
569 : : class(slc_primitive_potential_t), intent(inout) :: self
570 : : integer, intent(inout) :: nn
571 : : integer, intent(in) :: ilist(nn)
572 : : integer, intent(in) :: jlist(4, nn)
573 : : integer, intent(in) :: ulist(4, nn)
574 : : integer, intent(in) :: vlist(4, nn)
575 : : real(dp), intent(in) :: vallist(nn)
576 : :
577 : : integer :: idx
578 : :
579 [ + + ]: 16 : call self%tijuv%initialize(mshape=[-1, -1, -1, self%nspin*3, self%nspin*3, self%natom*3, self%natom*3])
580 : :
581 [ + - ]: 2 : if (xmpi_comm_rank(xmpi_world)==0) then
582 [ + + ]: 650 : do idx=1, nn
583 : : call self%set_tijuv_1term(ilist(idx), jlist(1, idx), ulist(1, idx), vlist(1, idx), &
584 : 650 : & jlist(2:4,idx), ulist(2:4,idx), vlist(2:4,idx), vallist(idx))
585 : : end do
586 : : endif
587 : :
588 : 2 : call self%tijuv%sum_duplicates()
589 : :
590 : 2 : end subroutine set_tijuv
591 : :
592 : : !-------------------------------------
593 : : ! add one entry to sparse tijuv matrix
594 : : !-------------------------------------
595 : 648 : subroutine set_tijuv_1term(self, ii, jj, uu, vv, Rj, Ru, Rv, val)
596 : : class(slc_primitive_potential_t), intent(inout) :: self
597 : : integer, intent(in) :: ii
598 : : integer, intent(in) :: jj
599 : : integer, intent(in) :: uu
600 : : integer, intent(in) :: vv
601 : : integer, intent(in) :: Rj(3)
602 : : integer, intent(in) :: Ru(3)
603 : : integer, intent(in) :: Rv(3)
604 : : real(dp), intent(in) :: val
605 : :
606 : : integer :: indRj, indRu, indRv
607 : :
608 : 648 : call self%tRjlist%push_unique(Rj, position=indRj)
609 : 648 : call self%tRulist%push_unique(Ru, position=indRu)
610 : 648 : call self%tRvlist%push_unique(Rv, position=indRv)
611 : :
612 [ + + ]: 5184 : call self%tijuv%add_entry(ind=[indRj, indRu, indRv, ii, jj, uu, vv], val=val)
613 : :
614 : 648 : end subroutine set_tijuv_1term
615 : :
616 : :
617 : : !-----------------------------------------------------------------
618 : : ! transfer parameter information from primitive cell to supercell
619 : : ! TODO: test
620 : : !-----------------------------------------------------------------
621 : 2 : subroutine fill_supercell(self, scmaker, params, scpot, supercell)
622 : : class(slc_primitive_potential_t) , intent(inout) :: self
623 : : type(supercell_maker_t), intent(inout) :: scmaker
624 : : type(multibinit_dtset_type), intent(inout) :: params
625 : : class(abstract_potential_t), pointer, intent(inout) :: scpot
626 : : type(mbsupercell_t), target :: supercell
627 : :
628 : : integer :: nspin, sc_nspin, natom, sc_natom
629 : : integer :: master, my_rank, comm, nproc, ierr
630 : : logical :: iam_master
631 : :
632 : 2 : call init_mpi_info(master, iam_master, my_rank, comm, nproc)
633 : :
634 : 2 : nspin=self%nspin
635 : 2 : natom=self%natom
636 : 2 : sc_nspin=nspin * scmaker%ncells
637 : 2 : sc_natom=natom * scmaker%ncells
638 : :
639 : 2 : call xmpi_bcast(sc_nspin, master, comm, ierr)
640 : 2 : call xmpi_bcast(sc_natom, master, comm, ierr)
641 [ - + ]: 2 : ABI_MALLOC_TYPE_SCALAR(slc_potential_t, scpot)
642 : :
643 : : select type(scpot) ! use select type because properties only defined for slc_potential are used
644 : : type is (slc_potential_t)
645 : 2 : call scpot%initialize(sc_nspin, sc_natom)
646 : 2 : call scpot%set_supercell(supercell)
647 : 2 : call scpot%set_params(params)
648 : : ! fill different coupling terms
649 [ + - ]: 4 : if (iam_master) then
650 : 2 : call self%fill_liu(scpot, scmaker)
651 : 2 : call self%fill_oiju(scpot, scmaker)
652 : 2 : call self%fill_niuv(scpot, scmaker)
653 : 2 : call self%fill_tijuv(scpot, scmaker)
654 : :
655 : : !Write information which terms are used
656 : 2 : write(std_out,'(A55)') 'Using the following terms for the spin-lattice coupling'
657 [ - + ]: 2 : if(scpot%has_bilin) write(std_out,'(A19)') 'Bilinear term: Liu'
658 [ + - ]: 2 : if(scpot%has_quadlin) write(std_out,'(A28)') 'Quadratic-linear term: Oiju'
659 [ - + ]: 2 : if(scpot%has_linquad) write(std_out,'(A28)') 'Linear-quadratic term: Niuv'
660 [ + + ]: 2 : if(scpot%has_biquad) write(std_out,'(A24)') 'Biquadratic term: Tijuv'
661 : : endif
662 : : end select
663 : 2 : end subroutine fill_supercell
664 : :
665 : : !--------------------------------------------------------
666 : : ! Check for each term if it is needed in the calculation
667 : : ! and present in the ncdf input then put into supercell
668 : : !--------------------------------------------------------
669 : 2 : subroutine fill_liu(self, scpot, scmaker)
670 : : class(slc_primitive_potential_t) , intent(inout) :: self
671 : : type(supercell_maker_t), intent(inout) :: scmaker
672 : : class(slc_potential_t), intent(inout) :: scpot
673 : :
674 [ - + ]: 2 : if(scpot%has_bilin) then
675 [ # # ]: 0 : if(self%has_bilin) then !did we actually find this in the netcdf file
676 : 0 : call self%liu%sum_duplicates()
677 : 0 : call self%set_liu_sc(scpot, scmaker)
678 : : else
679 : 0 : ABI_ERROR("No parameters for bilinear coupling available. Check your input and parameter files.")
680 : 0 : scpot%has_bilin = .False.
681 : : endif
682 : : endif
683 : 2 : end subroutine fill_liu
684 : :
685 : 2 : subroutine fill_niuv(self, scpot, scmaker)
686 : : class(slc_primitive_potential_t) , intent(inout) :: self
687 : : type(supercell_maker_t), intent(inout) :: scmaker
688 : : class(slc_potential_t), intent(inout) :: scpot
689 : :
690 [ - + ]: 2 : if(scpot%has_linquad) then
691 [ # # ]: 0 : if(self%has_linquad) then
692 : 0 : call self%niuv%sum_duplicates()
693 : 0 : call self%set_niuv_sc(scpot, scmaker)
694 : : else
695 : 0 : ABI_ERROR("No parameters for linear-quadratic coupling available. Check your input and parameter files.")
696 : 0 : scpot%has_linquad = .False.
697 : : endif
698 : : endif
699 : 2 : end subroutine fill_niuv
700 : :
701 : 2 : subroutine fill_oiju(self, scpot, scmaker)
702 : : class(slc_primitive_potential_t) , intent(inout) :: self
703 : : type(supercell_maker_t), intent(inout) :: scmaker
704 : : class(slc_potential_t), intent(inout) :: scpot
705 : :
706 [ + - ]: 2 : if(scpot%has_quadlin) then
707 [ + - ]: 2 : if(self%has_quadlin) then
708 : 2 : call self%oiju%sum_duplicates()
709 : 2 : call self%set_oiju_sc(scpot, scmaker)
710 : : else
711 : 0 : ABI_ERROR("No parameters for quadratic-linear coupling available. Check your input and parameter files.")
712 : 0 : scpot%has_quadlin = .False.
713 : : endif
714 : : endif
715 : 2 : end subroutine fill_oiju
716 : :
717 : 2 : subroutine fill_tijuv(self, scpot, scmaker)
718 : : class(slc_primitive_potential_t) , intent(inout) :: self
719 : : type(supercell_maker_t), intent(inout) :: scmaker
720 : : class(slc_potential_t), intent(inout) :: scpot
721 : :
722 [ + + ]: 2 : if(scpot%has_biquad) then
723 [ + - ]: 1 : if(self%has_biquad) then
724 : 1 : call self%tijuv%sum_duplicates()
725 : 1 : call self%set_tijuv_sc(scpot, scmaker)
726 : : else
727 : 0 : ABI_ERROR("No parameters for biquadratic coupling available. Check your input and parameter files.")
728 : 0 : scpot%has_biquad = .False.
729 : : endif
730 : : endif
731 : 2 : end subroutine fill_tijuv
732 : :
733 : : !------------------------------
734 : : ! fill liu terms in supercell
735 : : ! TODO: test
736 : : !------------------------------
737 : 0 : subroutine set_liu_sc(self, scpot, scmaker)
738 : : class(slc_primitive_potential_t), intent(inout) :: self
739 : : type(slc_potential_t), intent(inout) :: scpot
740 : : type(supercell_maker_t), intent(inout) :: scmaker
741 : :
742 : : integer :: icell, Ru_prim(3), liu_ind(3), iRu, i_prim, u_prim, inz
743 : : integer :: ngroup
744 : 0 : integer, allocatable :: i_sc(:), u_sc(:), Ru_sc(:,:)
745 : 0 : integer, allocatable :: i1list(:), ise(:)
746 : 0 : real(dp) :: val_sc(scmaker%ncells)
747 : :
748 : : integer :: master, my_rank, comm, nproc
749 : : logical :: iam_master
750 : :
751 : 0 : call init_mpi_info(master, iam_master, my_rank, comm, nproc)
752 : :
753 [ # # ]: 0 : if(iam_master) then
754 [ # # ]: 0 : call scpot%liu_sc%initialize(mshape=[self%nspin*3, self%natom*3])
755 : : endif
756 : :
757 [ # # ]: 0 : do inz=1, self%liu%nnz
758 : 0 : liu_ind=self%liu%get_ind_inz(inz)
759 : 0 : iRu=liu_ind(1)
760 : 0 : i_prim=liu_ind(2)
761 : 0 : u_prim=liu_ind(3)
762 [ # # ]: 0 : Ru_prim=self%lRulist%data(:,iRu)
763 : 0 : call scmaker%trans_i(nbasis=self%nspin*3, i=i_prim, i_sc=i_sc)
764 : 0 : call scmaker%trans_j_and_Rj(nbasis=self%natom*3, j=u_prim, Rj=Ru_prim, j_sc=u_sc, Rj_sc=Ru_sc)
765 [ # # ]: 0 : val_sc(:)= self%liu%val%data(inz)
766 [ # # ]: 0 : do icell=1, scmaker%ncells
767 : 0 : call scpot%add_liu_term(i_sc(icell), u_sc(icell), val_sc(icell))
768 : : end do
769 [ # # ]: 0 : ABI_SFREE(i_sc)
770 [ # # ]: 0 : ABI_SFREE(u_sc)
771 [ # # ]: 0 : ABI_SFREE(Ru_sc)
772 : : end do
773 : :
774 : 0 : call scpot%liu_sc%group_by_1dim(ngroup, i1list, ise)
775 [ # # ]: 0 : ABI_SFREE(i1list)
776 [ # # ]: 0 : ABI_SFREE(ise)
777 : :
778 [ # # # # : 0 : end subroutine set_liu_sc
# # # # #
# ]
779 : :
780 : : !------------------------------
781 : : ! fill niuv terms in supercell
782 : : ! TODO: test
783 : : !------------------------------
784 : 0 : subroutine set_niuv_sc(self, scpot, scmaker)
785 : : class(slc_primitive_potential_t), intent(inout) :: self
786 : : type(slc_potential_t), intent(inout) :: scpot
787 : : type(supercell_maker_t), intent(inout) :: scmaker
788 : :
789 : : integer :: icell, Ru_prim(3), Rv_prim(3), niuv_ind(5), iRu, iRv, i_prim, u_prim, v_prim, inz
790 : : integer :: ngroup
791 : 0 : integer, allocatable :: i_sc(:), u_sc(:), v_sc(:), Ru_sc(:,:), Rv_sc(:,:)
792 : 0 : integer, allocatable :: i1list(:), ise(:)
793 : 0 : real(dp) :: val_sc(scmaker%ncells)
794 : :
795 : : integer :: master, my_rank, comm, nproc
796 : : logical :: iam_master
797 : :
798 : 0 : call init_mpi_info(master, iam_master, my_rank, comm, nproc)
799 : :
800 [ # # ]: 0 : if(iam_master) then
801 [ # # ]: 0 : call scpot%niuv_sc%initialize(mshape=[self%nspin*3, self%natom*3, self%natom*3])
802 : : endif
803 : :
804 [ # # ]: 0 : do inz=1, self%niuv%nnz
805 : 0 : niuv_ind=self%niuv%get_ind_inz(inz)
806 : 0 : iRu=niuv_ind(1)
807 : 0 : iRv=niuv_ind(2)
808 : 0 : i_prim=niuv_ind(3)
809 : 0 : u_prim=niuv_ind(4)
810 : 0 : v_prim=niuv_ind(5)
811 [ # # ]: 0 : Ru_prim=self%nRulist%data(:,iRu)
812 [ # # ]: 0 : Rv_prim=self%nRvlist%data(:,iRv)
813 : 0 : call scmaker%trans_i(nbasis=self%nspin*3, i=i_prim, i_sc=i_sc)
814 : 0 : call scmaker%trans_j_and_Rj(nbasis=self%natom*3, j=u_prim, Rj=Ru_prim, j_sc=u_sc, Rj_sc=Ru_sc)
815 : 0 : call scmaker%trans_j_and_Rj(nbasis=self%natom*3, j=v_prim, Rj=Rv_prim, j_sc=v_sc, Rj_sc=Rv_sc)
816 [ # # ]: 0 : val_sc(:)= self%niuv%val%data(inz)
817 : 0 : do icell=1, scmaker%ncells
818 : : !call scpot%add_niuv_term(i_sc(icell), u_sc(icell), v_sc(icell), val_sc(icell))
819 : : end do
820 [ # # ]: 0 : ABI_SFREE(i_sc)
821 [ # # ]: 0 : ABI_SFREE(u_sc)
822 [ # # ]: 0 : ABI_SFREE(v_sc)
823 [ # # ]: 0 : ABI_SFREE(Ru_sc)
824 [ # # ]: 0 : ABI_SFREE(Rv_sc)
825 : : end do
826 : :
827 : 0 : call scpot%niuv_sc%group_by_1dim(ngroup, i1list, ise)
828 [ # # ]: 0 : ABI_SFREE(i1list)
829 [ # # ]: 0 : ABI_SFREE(ise)
830 : :
831 [ # # # # : 0 : end subroutine set_niuv_sc
# # # # #
# # # #
# ]
832 : :
833 : :
834 : : !------------------------------
835 : : ! fill oiju terms in supercell
836 : : ! TODO: test
837 : : !------------------------------
838 : 2 : subroutine set_oiju_sc(self, scpot, scmaker)
839 : : class(slc_primitive_potential_t), intent(inout) :: self
840 : : class(slc_potential_t), intent(inout) :: scpot
841 : : type(supercell_maker_t), intent(inout) :: scmaker
842 : :
843 : : integer :: icell, Rj_prim(3), Ru_prim(3), oiju_ind(5), iRj, iRu, i_prim, j_prim, u_prim, inz
844 : : integer :: ngroup
845 : 2 : integer, allocatable :: i_sc(:), j_sc(:), u_sc(:), Rj_sc(:, :), Ru_sc(:,:)
846 : 2 : integer, allocatable :: i1list(:), ise(:)
847 : 4 : real(dp) :: val_sc(scmaker%ncells)
848 : :
849 : : integer :: master, my_rank, comm, nproc
850 : : logical :: iam_master
851 : :
852 : 2 : call init_mpi_info(master, iam_master, my_rank, comm, nproc)
853 : :
854 [ + - ]: 2 : if(iam_master) then
855 [ + + ]: 8 : call scpot%oiju_sc%initialize(mshape=[self%nspin*3, self%nspin*3, self%natom*3])
856 : : endif
857 : :
858 [ + + ]: 4826 : do inz=1, self%oiju%nnz
859 : 4824 : oiju_ind=self%oiju%get_ind_inz(inz)
860 : 4824 : iRj=oiju_ind(1)
861 : 4824 : iRu=oiju_ind(2)
862 : 4824 : i_prim=oiju_ind(3)
863 : 4824 : j_prim=oiju_ind(4)
864 : 4824 : u_prim=oiju_ind(5)
865 [ + + ]: 19296 : Rj_prim=self%oRjlist%data(:,iRj)
866 [ + + ]: 19296 : Ru_prim=self%oRulist%data(:,iRu)
867 : 4824 : call scmaker%trans_i(nbasis=self%nspin*3, i=i_prim, i_sc=i_sc)
868 : 4824 : call scmaker%trans_j_and_Rj(nbasis=self%nspin*3, j=j_prim, Rj=Rj_prim, j_sc=j_sc, Rj_sc=Rj_sc)
869 : 4824 : call scmaker%trans_j_and_Rj(nbasis=self%natom*3, j=u_prim, Rj=Ru_prim, j_sc=u_sc, Rj_sc=Ru_sc)
870 [ + + ]: 1046808 : val_sc(:)= self%oiju%val%data(inz)
871 [ + + ]: 1046808 : do icell=1, scmaker%ncells
872 : 1046808 : call scpot%add_oiju_term(i_sc(icell), j_sc(icell), u_sc(icell), val_sc(icell))
873 : : end do
874 [ + - ]: 4824 : ABI_SFREE(i_sc)
875 [ + - ]: 4824 : ABI_SFREE(j_sc)
876 [ + - ]: 4824 : ABI_SFREE(u_sc)
877 [ + - ]: 4824 : ABI_SFREE(Rj_sc)
878 [ + - ]: 4826 : ABI_SFREE(Ru_sc)
879 : : end do
880 : :
881 : 2 : call scpot%oiju_sc%group_by_1dim(ngroup, i1list, ise)
882 [ + - ]: 2 : ABI_SFREE(i1list)
883 [ + - ]: 2 : ABI_SFREE(ise)
884 : :
885 [ - + - + : 2 : end subroutine set_oiju_sc
- + - + -
+ - + -
+ ]
886 : :
887 : 1 : subroutine set_tijuv_sc(self, scpot, scmaker)
888 : : class(slc_primitive_potential_t), intent(inout) :: self
889 : : type(slc_potential_t), intent(inout) :: scpot
890 : : type(supercell_maker_t), intent(inout) :: scmaker
891 : :
892 : : integer :: icell, Rj(3), Ru(3), Rv(3), tijuv_ind(7), iRj, iRu, iRv, ii, ij, iu, iv, inz
893 : 1 : integer, allocatable :: i_sc(:), j_sc(:), u_sc(:), v_sc(:), Rj_sc(:, :), Ru_sc(:,:), Rv_sc(:,:)
894 : 2 : real(dp) :: val_sc(scmaker%ncells)
895 : :
896 : : integer :: master, my_rank, comm, nproc
897 : : logical :: iam_master
898 : :
899 : 1 : call init_mpi_info(master, iam_master, my_rank, comm, nproc)
900 : :
901 [ + - ]: 1 : if(iam_master) then
902 [ + + ]: 5 : call scpot%tijuv_sc%initialize(mshape=[self%nspin*3, self%nspin*3, self%natom*3, self%natom*3])
903 [ + + ]: 5 : call scpot%tuvij_sc%initialize(mshape=[self%natom*3, self%natom*3, self%nspin*3, self%nspin*3])
904 : : endif
905 : :
906 [ + + ]: 325 : do inz=1, self%tijuv%nnz
907 : 324 : tijuv_ind=self%tijuv%get_ind_inz(inz)
908 : 324 : iRj=tijuv_ind(1)
909 : 324 : iRu=tijuv_ind(2)
910 : 324 : iRv=tijuv_ind(3)
911 : 324 : ii=tijuv_ind(4)
912 : 324 : ij=tijuv_ind(5)
913 : 324 : iu=tijuv_ind(6)
914 : 324 : iv=tijuv_ind(7)
915 [ + + ]: 1296 : Rj=self%tRjlist%data(:,iRj)
916 [ + + ]: 1296 : Ru=self%tRulist%data(:,iRu)
917 [ + + ]: 1296 : Rv=self%tRvlist%data(:,iRv)
918 : 324 : call scmaker%trans_i(nbasis=self%nspin*3, i=ii, i_sc=i_sc)
919 : 324 : call scmaker%trans_j_and_Rj(nbasis=self%nspin*3, j=ij, Rj=Rj, j_sc=j_sc, Rj_sc=Rj_sc)
920 : 324 : call scmaker%trans_j_and_Rj(nbasis=self%natom*3, j=iu, Rj=Ru, j_sc=u_sc, Rj_sc=Ru_sc)
921 : 324 : call scmaker%trans_j_and_Rj(nbasis=self%natom*3, j=iv, Rj=Rv, j_sc=v_sc, Rj_sc=Rv_sc)
922 [ + + ]: 70308 : val_sc(:)= self%tijuv%val%data(inz)
923 [ + + ]: 70308 : do icell=1, scmaker%ncells
924 : 70308 : call scpot%add_tijuv_term(i_sc(icell), j_sc(icell), u_sc(icell), v_sc(icell), val_sc(icell))
925 : : end do
926 [ + - ]: 324 : ABI_SFREE(i_sc)
927 [ + - ]: 324 : ABI_SFREE(j_sc)
928 [ + - ]: 324 : ABI_SFREE(u_sc)
929 [ + - ]: 324 : ABI_SFREE(v_sc)
930 [ + - ]: 324 : ABI_SFREE(Rj_sc)
931 [ + - ]: 324 : ABI_SFREE(Ru_sc)
932 [ + - ]: 325 : ABI_SFREE(Rv_sc)
933 : : end do
934 : :
935 : 1 : call scpot%tijuv_sc%group_by_pair()
936 : 1 : call scpot%tuvij_sc%group_by_pair()
937 : :
938 [ - + - + : 1 : end subroutine set_tijuv_sc
- + - + -
+ - + -
+ ]
939 : :
940 : : !!***
941 [ + + - + : 8 : end module m_slc_primitive_potential
+ + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + - +
- + ]
|
