Line data Source code
1 : !!****m* ABINIT/m_spin_primitive_potential
2 : !! NAME
3 : !! m_spin_primitive_potential
4 : !!
5 : !! FUNCTION
6 : !! This module contains the atomic structures and the spin hamiltonian inside the primitive cell
7 : !! which can be directly mapped to the xml file. It is not for the calculation, but for constructing
8 : !! the hamiltonian in supercell. It is also used as input for the magnon band structure calculation.
9 : !!
10 : !! Datatypes:
11 : !! spin_primitive_potential_t
12 : !!
13 : !! Subroutines:
14 : !!
15 : !! COPYRIGHT
16 : !! Copyright (C) 2001-2026 ABINIT group (hexu)
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 :
25 : #if defined HAVE_CONFIG_H
26 : #include "config.h"
27 : #endif
28 : #include "abi_common.h"
29 :
30 : module m_spin_primitive_potential
31 : use, intrinsic :: iso_c_binding
32 : use m_dynamic_array, only: int_array_type, real_array_type, int2d_array_type
33 : use m_mathfuncs
34 : use defs_basis
35 : use m_abicore
36 : use m_errors
37 : use m_xmpi
38 : use m_nctk
39 : #if defined HAVE_NETCDF
40 : use netcdf
41 : #endif
42 :
43 : use m_mpi_scheduler, only: init_mpi_info
44 : use m_multibinit_dataset, only: multibinit_dtset_type
45 : use m_multibinit_io_xml, only: xml_read_spin, xml_free_spin
46 : use m_multibinit_cell, only: mbcell_t, mbsupercell_t
47 : use m_primitive_potential, only: primitive_potential_t
48 : use m_abstract_potential, only: abstract_potential_t
49 : use m_dynamic_array, only: int2d_array_type
50 : use m_supercell_maker, only: supercell_maker_t
51 : use m_spmat_ndcoo, only: ndcoo_mat_t
52 : use m_spin_potential, only: spin_potential_t
53 :
54 : implicit none
55 : private
56 : !!***
57 :
58 :
59 : type, public, extends(primitive_potential_t) :: spin_primitive_potential_t
60 : integer :: natoms
61 : integer :: nspin ! on every mpi node
62 : type(ndcoo_mat_t) :: coeff ! only on master node
63 : type(int2d_array_type) :: Rlist !only on master node
64 :
65 : ! Here the coeff is a NOCOO matrix, which has the indices and values.
66 : ! The indices is a 2d integer matrix.
67 : ! | indices | value|
68 : ! | i1 | j1| indR1| val1 |
69 : ! | i2 | j2| indR2| val2 |
70 : !
71 : ! and the Rlist is a list of R values.
72 : ! for the k'th element ik, jk, indRk, valk, the R value is Rlist(indRk).
73 : contains
74 : procedure:: initialize
75 : procedure:: finalize
76 : procedure :: set_spin_primcell ! set primitve cell infor (rprimd, xcart, ...)
77 : procedure :: set_bilinear_1term ! set one (i,j,R) val(3,3)
78 : procedure:: set_bilinear ! set list of bilinear terms (ilist, jlist, Rlist, valllist)
79 : procedure:: set_exchange ! set list of exchange terms
80 : procedure:: set_dmi ! set list of dmi terms
81 : procedure:: set_sia ! set list of sia terms
82 : procedure :: add_input_sia ! add a SIA term from input file
83 : procedure :: load_from_files ! read potential from files
84 : procedure:: read_xml ! read potential from one xml file
85 : procedure :: read_netcdf ! read potential from one netcdf file
86 : procedure:: fill_supercell ! fill supercell.
87 : end type spin_primitive_potential_t
88 :
89 : contains
90 :
91 2 : subroutine initialize(self, primcell)
92 : class(spin_primitive_potential_t), intent(inout) :: self
93 : type(mbcell_t), target, intent(inout) :: primcell
94 : !integer, intent(in) :: nspin
95 2 : self%primcell=>primcell
96 2 : self%label="Spin_primitive_potential"
97 2 : self%has_spin=.True.
98 2 : self%has_displacement=.False.
99 2 : self%has_strain=.False.
100 2 : self%has_lwf=.False.
101 2 : end subroutine initialize
102 :
103 :
104 2 : subroutine finalize(self)
105 : class(spin_primitive_potential_t), intent(inout) :: self
106 2 : call self%coeff%finalize()
107 2 : call self%Rlist%finalize()
108 2 : nullify(self%primcell)
109 2 : self%nspin=0
110 2 : self%natoms=0
111 2 : self%label="Destroyed Spin_primitive_potential"
112 2 : call self%primitive_potential_t%finalize()
113 2 : end subroutine finalize
114 :
115 :
116 4 : subroutine set_spin_primcell(self, natoms, unitcell, positions, &
117 2 : & nspin, index_spin, spinat, gyroratios, damping_factors, &
118 : & Sref, ref_spin_qpoint, ref_spin_rotate_axis)
119 :
120 : class(spin_primitive_potential_t), intent(inout) :: self
121 : integer, intent(inout) :: natoms, nspin, index_spin(:)
122 : real(dp), intent(inout) :: unitcell(3, 3), positions(3,natoms)
123 : real(dp), intent(inout) :: spinat(3, natoms), gyroratios(nspin), damping_factors(nspin)
124 : real(dp), optional, intent(inout) :: Sref(3, nspin), ref_spin_qpoint(3), ref_spin_rotate_axis(3)
125 :
126 : integer :: iatom, ispin
127 4 : real(dp) :: ms(nspin), spin_positions(3, nspin)
128 : integer :: master, my_rank, comm, nproc, ierr
129 : logical :: iam_master
130 2 : call init_mpi_info(master, iam_master, my_rank, comm, nproc)
131 :
132 2 : ABI_UNUSED_A(unitcell)
133 :
134 2 : self%nspin=nspin
135 2 : call xmpi_bcast(self%nspin, master, comm, ierr)
136 2 : if (iam_master) then
137 8 : call self%coeff%initialize(mshape=[-1, self%nspin*3, self%nspin*3])
138 12 : do iatom=1, natoms
139 10 : ispin=index_spin(iatom)
140 12 : if(ispin>0) then
141 8 : spin_positions(:,ispin)= positions(:, iatom)
142 8 : ms(ispin) = sqrt(sum(spinat(:,iatom)**2, dim=1))* mu_B
143 : end if
144 : end do
145 : endif
146 : call self%primcell%set_spin(nspin, ms, unitcell, spin_positions, gyroratios, damping_factors, &
147 2 : & Sref=Sref, ref_qpoint=ref_spin_qpoint, ref_rotate_axis=ref_spin_rotate_axis)
148 :
149 : !call self%primcell%set_lattice(natom=natoms, cell=unitcell, xcart=spin_positions, masses, zion)
150 2 : end subroutine set_spin_primcell
151 :
152 :
153 2 : subroutine load_from_files(self, params, fnames)
154 : class(spin_primitive_potential_t), intent(inout) :: self
155 : type(multibinit_dtset_type), intent(in) :: params
156 : character(len=fnlen), intent(in) :: fnames(:)
157 : character(len=fnlen) :: fname
158 : character(len=500) :: message
159 : integer :: ii
160 : logical:: use_sia, use_exchange, use_dmi, use_bi
161 2 : fname=params%spin_pot_fname
162 : ABI_UNUSED(fnames)
163 2 : if (xmpi_comm_rank(xmpi_world)==0) then
164 164 : write(message,'(a,(80a),3a)') ch10,('=',ii=1,80),ch10,ch10,&
165 166 : & 'reading spin terms.'
166 2 : call wrtout(ab_out,message,'COLL')
167 2 : call wrtout(std_out,message,'COLL')
168 : endif
169 2 : use_exchange=.True.
170 2 : use_sia=.True.
171 2 : use_dmi=.True.
172 2 : use_bi=.True.
173 : ! Do not use sia term in xml if spin_sia_add is set to 1.
174 2 : if(params%spin_sia_add == 1) use_sia=.False.
175 :
176 2 : if(endswith(trim(fname), ".xml")) then
177 : call self%read_xml( trim(fname)//char(0), &
178 0 : & use_exchange=use_exchange, use_sia=use_sia, use_dmi=use_dmi, use_bi=use_bi)
179 2 : else if(endswith(trim(fname), ".nc")) then
180 2 : call self%read_netcdf(fname)
181 : endif
182 2 : if (params%spin_sia_add /= 0 ) then
183 : call self%add_input_sia(params%spin_sia_k1amp, &
184 0 : & params%spin_sia_k1dir)
185 : end if
186 2 : end subroutine load_from_files
187 :
188 :
189 : !-------------------------------------------------------------------!
190 : ! load_from_netcdf
191 : ! Load spin primitive potential from a netcdf file.
192 : !-------------------------------------------------------------------!
193 2 : subroutine read_netcdf(self, fname)
194 : class(spin_primitive_potential_t), intent(inout) :: self
195 : character(len=fnlen), intent(in) :: fname
196 : integer :: ierr, ncid, varid
197 :
198 : integer :: nspin, natom
199 : real(dp) :: cell(3,3)
200 : real(dp) :: ref_spin_qpoint(3), ref_spin_rotate_axis(3)
201 2 : real(dp), allocatable :: ref_spin_orientation(:, :)
202 2 : integer, allocatable :: index_spin(:)
203 2 : real(dp), allocatable :: spinat(:,:)
204 2 : real(dp), allocatable :: xcart(:,:)
205 2 : real(dp), allocatable :: gyroratio(:)
206 2 : real(dp), allocatable :: gilbert_damping(:)
207 :
208 : integer :: spin_exchange_nterm
209 2 : integer , allocatable:: spin_exchange_ilist(:)
210 2 : integer , allocatable:: spin_exchange_jlist(:)
211 2 : integer , allocatable:: spin_exchange_Rlist(:,:)
212 2 : real(dp), allocatable:: spin_exchange_vallist(:,:)
213 :
214 : integer :: spin_dmi_nterm
215 2 : integer , allocatable:: spin_dmi_ilist(:)
216 2 : integer , allocatable:: spin_dmi_jlist(:)
217 2 : integer , allocatable:: spin_dmi_Rlist(:,:)
218 2 : real(dp), allocatable:: spin_dmi_vallist(:,:)
219 :
220 :
221 : integer :: spin_SIA_nterm
222 2 : integer , allocatable:: spin_SIA_ilist(:)
223 2 : real(dp), allocatable:: spin_SIA_k1list(:)
224 2 : real(dp), allocatable:: spin_SIA_k1dirlist(:,:)
225 :
226 :
227 : integer :: spin_bilinear_nterm
228 2 : integer , allocatable:: spin_bilinear_ilist(:)
229 2 : integer , allocatable:: spin_bilinear_jlist(:)
230 2 : integer , allocatable:: spin_bilinear_Rlist(:,:)
231 2 : real(dp), allocatable:: spin_bilinear_vallist(:,:,:)
232 :
233 : #if defined HAVE_NETCDF
234 :
235 : ! open netcdf file
236 2 : ierr=nf90_open(trim(fname)//char(0), NF90_NOWRITE, ncid)
237 2 : NCF_CHECK_MSG(ierr, "open netcdf file")
238 :
239 : ! read primcell info
240 2 : ierr=nctk_get_dim(ncid, "natom", natom)
241 2 : NCF_CHECK_MSG(ierr, "getting natom in spin potential file")
242 2 : ierr=nctk_get_dim(ncid, "nspin", nspin)
243 2 : NCF_CHECK_MSG(ierr, "getting nspin in spin potential file")
244 :
245 : ! allocate for primcell
246 6 : ABI_MALLOC(xcart, (3, natom))
247 4 : ABI_MALLOC(spinat, (3, natom))
248 6 : ABI_MALLOC(index_spin, (natom))
249 6 : ABI_MALLOC(gyroratio, (nspin))
250 4 : ABI_MALLOC(gilbert_damping, (nspin))
251 6 : ABI_MALLOC(ref_spin_orientation, (3, nspin))
252 :
253 2 : ierr =nf90_inq_varid(ncid, "ref_cell", varid)
254 2 : NCF_CHECK_MSG(ierr, "ref_cell")
255 2 : ierr = nf90_get_var(ncid, varid, cell)
256 2 : NCF_CHECK_MSG(ierr, "ref_cell")
257 26 : cell(:,:)=cell(:,:)/ Bohr_Ang
258 :
259 2 : ierr =nf90_inq_varid(ncid, "ref_xcart", varid)
260 2 : NCF_CHECK_MSG(ierr, "ref_xcart")
261 2 : ierr = nf90_get_var(ncid, varid, xcart)
262 2 : NCF_CHECK_MSG(ierr, "ref_xcart")
263 :
264 42 : xcart(:,:)=xcart(:,:)/ Bohr_Ang
265 :
266 2 : ierr =nf90_inq_varid(ncid, "spin_ref_orientation", varid)
267 2 : if(ierr==NF90_NOERR) then
268 0 : ierr = nf90_get_var(ncid, varid, ref_spin_orientation)
269 0 : NCF_CHECK_MSG(ierr, "spin_ref_orientation")
270 : else
271 2 : ABI_WARNING("Could not read spin_ref_orientation from nc file, will use z-direction.")
272 4 : ref_spin_orientation(1,:)=0.0d0
273 4 : ref_spin_orientation(2,:)=0.0d0
274 4 : ref_spin_orientation(3,:)=1.0d0
275 : endif
276 :
277 : !NCF_CHECK_MSG(ierr, "spin_ref_orientation")
278 : !ierr = nf90_get_var(ncid, varid, ref_spin_orientation)
279 : !NCF_CHECK_MSG(ierr, "spin_ref_orientation")
280 :
281 2 : ierr =nf90_inq_varid(ncid, "spin_ref_qpoint", varid)
282 2 : if(ierr==NF90_NOERR) then
283 2 : ierr = nf90_get_var(ncid, varid, ref_spin_qpoint)
284 2 : NCF_CHECK_MSG(ierr, "spin_ref_qpoint")
285 : else
286 0 : ABI_WARNING("Could not read spin_ref_qpoint from nc file, will use Gamma point.")
287 0 : ref_spin_qpoint(:)=0.0d0
288 : endif
289 : !NCF_CHECK_MSG(ierr, "spin_ref_qpoint")
290 : !ierr = nf90_get_var(ncid, varid, ref_spin_qpoint)
291 : !NCF_CHECK_MSG(ierr, "spin_ref_qpoint")
292 :
293 2 : ierr =nf90_inq_varid(ncid, "spin_ref_rotate_axis", varid)
294 2 : if(ierr==NF90_NOERR) then
295 2 : ierr = nf90_get_var(ncid, varid, ref_spin_rotate_axis)
296 2 : NCF_CHECK_MSG(ierr, "spin_ref_rotate_axis")
297 : else
298 0 : ABI_WARNING("Could not read spin_ref_rotate_axis from nc file, will use x-axis.")
299 0 : ref_spin_rotate_axis(1)=1.0d0
300 0 : ref_spin_rotate_axis(2)=0.0d0
301 0 : ref_spin_rotate_axis(3)=0.0d0
302 : endif
303 :
304 : !NCF_CHECK_MSG(ierr, "spin_ref_rotate_axis")
305 : !ierr = nf90_get_var(ncid, varid, ref_spin_rotate_axis)
306 : !NCF_CHECK_MSG(ierr, "spin_ref_rotate_axis")
307 :
308 2 : ierr =nf90_inq_varid(ncid, "spinat", varid)
309 2 : NCF_CHECK_MSG(ierr, "spinat")
310 2 : ierr = nf90_get_var(ncid, varid, spinat)
311 2 : NCF_CHECK_MSG(ierr, "spinat")
312 :
313 2 : ierr =nf90_inq_varid(ncid, "index_spin", varid)
314 2 : NCF_CHECK_MSG(ierr, "index_spin")
315 2 : ierr = nf90_get_var(ncid, varid, index_spin)
316 2 : NCF_CHECK_MSG(ierr, "index_spin")
317 :
318 2 : ierr =nf90_inq_varid(ncid, "gyroratio", varid)
319 2 : NCF_CHECK_MSG(ierr, "gyroratio")
320 2 : ierr = nf90_get_var(ncid, varid, gyroratio)
321 2 : NCF_CHECK_MSG(ierr, "gyroratio")
322 :
323 2 : ierr =nf90_inq_varid(ncid, "gilbert_damping", varid)
324 2 : NCF_CHECK_MSG(ierr, "gilbert_damping")
325 2 : ierr = nf90_get_var(ncid, varid, gilbert_damping)
326 2 : NCF_CHECK_MSG(ierr, "gilbert_damping")
327 :
328 : call self%set_spin_primcell( natoms=natom, unitcell=cell, positions=xcart, &
329 : & nspin=nspin, index_spin=index_spin, spinat=spinat, &
330 : & gyroratios=gyroratio, damping_factors=gilbert_damping, &
331 2 : & Sref=ref_spin_orientation, ref_spin_qpoint=ref_spin_qpoint, ref_spin_rotate_axis=ref_spin_rotate_axis)
332 :
333 2 : ABI_SFREE(xcart)
334 2 : ABI_SFREE(spinat)
335 2 : ABI_SFREE(index_spin)
336 2 : ABI_SFREE(gyroratio)
337 2 : ABI_SFREE(gilbert_damping)
338 2 : ABI_SFREE(ref_spin_orientation)
339 :
340 : !== read exchange terms
341 2 : ierr=nf90_inq_dimid(ncid, "spin_exchange_nterm", spin_exchange_nterm)
342 2 : if (ierr==0) then ! if has exchange
343 2 : ierr=nctk_get_dim(ncid, "spin_exchange_nterm", spin_exchange_nterm)
344 6 : ABI_MALLOC(spin_exchange_ilist, (spin_exchange_nterm))
345 4 : ABI_MALLOC(spin_exchange_jlist, (spin_exchange_nterm))
346 6 : ABI_MALLOC(spin_exchange_Rlist, (3,spin_exchange_nterm))
347 6 : ABI_MALLOC(spin_exchange_vallist, (3,spin_exchange_nterm))
348 :
349 2 : ierr =nf90_inq_varid(ncid, "spin_exchange_ilist", varid)
350 2 : NCF_CHECK_MSG(ierr, "spin_exchange_ilist")
351 2 : ierr = nf90_get_var(ncid, varid, spin_exchange_ilist)
352 2 : NCF_CHECK_MSG(ierr, "spin_exchange_ilist")
353 :
354 2 : ierr =nf90_inq_varid(ncid, "spin_exchange_jlist", varid)
355 2 : NCF_CHECK_MSG(ierr, "spin_exchange_jlist")
356 2 : ierr = nf90_get_var(ncid, varid, spin_exchange_jlist)
357 2 : NCF_CHECK_MSG(ierr, "spin_exchange_jlist")
358 :
359 2 : ierr =nf90_inq_varid(ncid, "spin_exchange_Rlist", varid)
360 2 : NCF_CHECK_MSG(ierr, "spin_exchange_Rlist")
361 2 : ierr = nf90_get_var(ncid, varid, spin_exchange_Rlist)
362 2 : NCF_CHECK_MSG(ierr, "spin_exchange_Rlist")
363 :
364 :
365 2 : ierr =nf90_inq_varid(ncid, "spin_exchange_vallist", varid)
366 2 : NCF_CHECK_MSG(ierr, "spin_exchange_vallist")
367 2 : ierr = nf90_get_var(ncid, varid, spin_exchange_vallist)
368 2 : NCF_CHECK_MSG(ierr, "spin_exchange_vallist")
369 :
370 210 : spin_exchange_vallist(:,:) = spin_exchange_vallist(:,:) * eV_Ha
371 :
372 : call self%set_exchange(n=spin_exchange_nterm, ilist=spin_exchange_ilist, &
373 : & jlist=spin_exchange_jlist, Rlist=spin_exchange_Rlist, &
374 2 : & vallist=spin_exchange_vallist)
375 :
376 2 : ABI_SFREE(spin_exchange_ilist)
377 2 : ABI_SFREE(spin_exchange_jlist)
378 2 : ABI_SFREE(spin_exchange_Rlist)
379 2 : ABI_SFREE(spin_exchange_vallist)
380 : endif
381 :
382 :
383 :
384 : !== read dmi terms
385 2 : ierr=nf90_inq_dimid(ncid, "spin_dmi_nterm", spin_dmi_nterm)
386 2 : if (ierr==0) then ! if has dmi
387 0 : ierr=nctk_get_dim(ncid, "spin_dmi_nterm", spin_dmi_nterm)
388 0 : NCF_CHECK_MSG(ierr, "spin_dmi_nterm found but is not readable")
389 0 : ABI_MALLOC(spin_dmi_ilist, (spin_dmi_nterm))
390 0 : ABI_MALLOC(spin_dmi_jlist, (spin_dmi_nterm))
391 0 : ABI_MALLOC(spin_dmi_Rlist, (3,spin_dmi_nterm))
392 0 : ABI_MALLOC(spin_dmi_vallist, (3,spin_dmi_nterm))
393 :
394 0 : ierr =nf90_inq_varid(ncid, "spin_dmi_ilist", varid)
395 0 : NCF_CHECK_MSG(ierr, "spin_dmi_ilist")
396 0 : ierr = nf90_get_var(ncid, varid, spin_dmi_ilist)
397 0 : NCF_CHECK_MSG(ierr, "spin_dmi_ilist")
398 :
399 0 : ierr =nf90_inq_varid(ncid, "spin_dmi_jlist", varid)
400 0 : NCF_CHECK_MSG(ierr, "spin_dmi_jlist")
401 0 : ierr = nf90_get_var(ncid, varid, spin_dmi_jlist)
402 0 : NCF_CHECK_MSG(ierr, "spin_dmi_jlist")
403 :
404 0 : ierr =nf90_inq_varid(ncid, "spin_dmi_Rlist", varid)
405 0 : NCF_CHECK_MSG(ierr, "spin_dmi_Rlist")
406 0 : ierr = nf90_get_var(ncid, varid, spin_dmi_Rlist)
407 0 : NCF_CHECK_MSG(ierr, "spin_dmi_Rlist")
408 :
409 :
410 0 : ierr =nf90_inq_varid(ncid, "spin_dmi_vallist", varid)
411 0 : NCF_CHECK_MSG(ierr, "spin_dmi_vallist")
412 0 : ierr = nf90_get_var(ncid, varid, spin_dmi_vallist)
413 0 : NCF_CHECK_MSG(ierr, "spin_dmi_vallist")
414 :
415 0 : spin_dmi_vallist(:,:) = spin_dmi_vallist(:,:) * eV_Ha
416 :
417 : call self%set_dmi(n=spin_dmi_nterm, ilist=spin_dmi_ilist, &
418 : & jlist=spin_dmi_jlist, Rlist=spin_dmi_Rlist, &
419 0 : & vallist=spin_dmi_vallist)
420 :
421 0 : ABI_SFREE(spin_dmi_ilist)
422 0 : ABI_SFREE(spin_dmi_jlist)
423 0 : ABI_SFREE(spin_dmi_Rlist)
424 0 : ABI_SFREE(spin_dmi_vallist)
425 : endif
426 :
427 : !== read SIA terms
428 2 : ierr=nf90_inq_dimid(ncid, "spin_SIA_nterm", spin_SIA_nterm)
429 2 : if (ierr==0) then ! if has SIA
430 0 : ierr=nctk_get_dim(ncid, "spin_SIA_nterm", spin_SIA_nterm)
431 0 : ABI_MALLOC(spin_SIA_ilist, (spin_SIA_nterm))
432 0 : ABI_MALLOC(spin_SIA_k1list, (spin_SIA_nterm))
433 0 : ABI_MALLOC(spin_SIA_k1dirlist, (3,spin_SIA_nterm))
434 :
435 0 : ierr =nf90_inq_varid(ncid, "spin_SIA_ilist", varid)
436 0 : NCF_CHECK_MSG(ierr, "spin_SIA_ilist")
437 0 : ierr = nf90_get_var(ncid, varid, spin_SIA_ilist)
438 0 : NCF_CHECK_MSG(ierr, "spin_SIA_ilist")
439 :
440 0 : ierr =nf90_inq_varid(ncid, "spin_SIA_k1list", varid)
441 0 : NCF_CHECK_MSG(ierr, "spin_SIA_k1list")
442 0 : ierr = nf90_get_var(ncid, varid, spin_SIA_k1list)
443 0 : NCF_CHECK_MSG(ierr, "spin_SIA_k1list")
444 :
445 :
446 0 : ierr =nf90_inq_varid(ncid, "spin_SIA_k1dirlist", varid)
447 0 : NCF_CHECK_MSG(ierr, "spin_SIA_k1dirlist")
448 0 : ierr = nf90_get_var(ncid, varid, spin_SIA_k1dirlist)
449 0 : NCF_CHECK_MSG(ierr, "spin_SIA_k1dirlist")
450 :
451 0 : spin_SIA_k1list(:) = spin_SIA_k1list(:) * eV_Ha
452 :
453 : call self%set_SIA(n=spin_SIA_nterm, ilist=spin_SIA_ilist, &
454 0 : & k1list=spin_SIA_k1list, k1dirlist=spin_SIA_k1dirlist)
455 :
456 0 : ABI_SFREE(spin_SIA_ilist)
457 0 : ABI_SFREE(spin_SIA_k1list)
458 0 : ABI_SFREE(spin_SIA_k1dirlist)
459 : endif
460 :
461 :
462 :
463 : ! read bilinear terms
464 2 : ierr=nf90_inq_dimid(ncid, "spin_bilinear_nterm", varid)
465 2 : if (ierr==0) then ! if has bilinear
466 0 : ABI_MALLOC(spin_bilinear_ilist, (spin_bilinear_nterm))
467 0 : ABI_MALLOC(spin_bilinear_jlist, (spin_bilinear_nterm))
468 0 : ABI_MALLOC(spin_bilinear_Rlist, (3,spin_bilinear_nterm))
469 0 : ABI_MALLOC(spin_bilinear_vallist, (3,3,spin_bilinear_nterm))
470 :
471 0 : ierr =nf90_inq_varid(ncid, "spin_bilinear_ilist", varid)
472 0 : NCF_CHECK_MSG(ierr, "spin_bilinear_ilist")
473 0 : ierr = nf90_get_var(ncid, varid, spin_bilinear_ilist)
474 0 : NCF_CHECK_MSG(ierr, "spin_bilinear_ilist")
475 :
476 0 : ierr =nf90_inq_varid(ncid, "spin_bilinear_jlist", varid)
477 0 : NCF_CHECK_MSG(ierr, "spin_bilinear_jlist")
478 0 : ierr = nf90_get_var(ncid, varid, spin_bilinear_jlist)
479 0 : NCF_CHECK_MSG(ierr, "spin_bilinear_jlist")
480 :
481 0 : ierr =nf90_inq_varid(ncid, "spin_bilinear_Rlist", varid)
482 0 : NCF_CHECK_MSG(ierr, "spin_bilinear_Rlist")
483 0 : ierr = nf90_get_var(ncid, varid, spin_bilinear_Rlist)
484 0 : NCF_CHECK_MSG(ierr, "spin_bilinear_Rlist")
485 :
486 0 : ierr =nf90_inq_varid(ncid, "spin_bilinear_vallist", varid)
487 0 : NCF_CHECK_MSG(ierr, "spin_bilinear_vallist")
488 0 : ierr = nf90_get_var(ncid, varid, spin_bilinear_vallist)
489 0 : NCF_CHECK_MSG(ierr, "spin_bilinear_vallist")
490 :
491 0 : spin_bilinear_vallist(:,:,:) = spin_bilinear_vallist(:,:,:) * eV_Ha
492 :
493 : call self%set_bilinear( n=spin_bilinear_nterm, ilist=spin_bilinear_ilist, &
494 : & jlist=spin_bilinear_jlist, Rlist=spin_bilinear_Rlist, &
495 0 : & vallist=spin_bilinear_vallist)
496 :
497 0 : ABI_SFREE(spin_bilinear_ilist)
498 0 : ABI_SFREE(spin_bilinear_jlist)
499 0 : ABI_SFREE(spin_bilinear_Rlist)
500 0 : ABI_SFREE(spin_bilinear_vallist)
501 : end if
502 :
503 2 : ierr=nf90_close(ncid)
504 2 : NCF_CHECK_MSG(ierr, "Close netcdf file")
505 : #else
506 : NETCDF_NOTENABLED_ERROR()
507 : #endif
508 2 : end subroutine read_netcdf
509 :
510 :
511 : !-------------------------------------------------------------------!
512 : ! set_bilinear_1term:
513 : ! Add a bilinear term
514 : ! Inputs:
515 : ! i: index of spin i
516 : ! j: index of spin j
517 : ! R: cell vector R (vector3)
518 : ! val : a 3*3 matrix.
519 : !-------------------------------------------------------------------!
520 52 : subroutine set_bilinear_1term(self, i, j, R, val)
521 : class(spin_primitive_potential_t), intent(inout) :: self
522 : integer, intent(in) :: i, j, R(3)
523 : real(dp), intent(in) :: val(3,3)
524 : real(dp) :: v
525 : integer :: indR, iv, jv
526 :
527 52 : if (xmpi_comm_rank(xmpi_world)==0) then
528 52 : call self%Rlist%push_unique(R, position=indR)
529 208 : do jv=1,3
530 676 : do iv=1,3
531 468 : v=val(iv,jv)
532 2028 : call self%coeff%add_entry(ind=[indR, (i-1)*3+iv, (j-1)*3+jv ], val=v)
533 : end do
534 : end do
535 : endif
536 52 : end subroutine set_bilinear_1term
537 :
538 : !-------------------------------------------------------------------!
539 : ! set_bilinear:
540 : !Inputs:
541 : ! n: number of terms
542 : ! ilist: list of i (length n)
543 : ! jlist: list of j (length n)
544 : ! Rlist: list of R mat(3, n)
545 : ! vallist: list of val . mat(3,3,n)
546 : !-------------------------------------------------------------------!
547 2 : subroutine set_bilinear(self, n, ilist, jlist, Rlist, vallist)
548 : class(spin_primitive_potential_t), intent(inout) :: self
549 : integer, intent(in) :: n, ilist(n), jlist(n), Rlist(3,n)
550 : real(dp), intent(in) :: vallist(3, 3,n)
551 : integer :: idx
552 2 : if (xmpi_comm_rank(xmpi_world)==0) then
553 54 : do idx = 1, n
554 54 : call self%set_bilinear_1term(ilist(idx), jlist(idx), Rlist(:,idx), vallist(:,:, idx))
555 : end do
556 : endif
557 2 : end subroutine set_bilinear
558 :
559 : !-------------------------------------------------------------------!
560 : ! set_exchange terms.
561 : ! same as set_bilinear, except the vallist only have the diagonal.
562 : !-------------------------------------------------------------------!
563 2 : subroutine set_exchange(self, n, ilist, jlist, Rlist, vallist)
564 : class(spin_primitive_potential_t), intent(inout) :: self
565 : integer, intent(in) :: n, ilist(:), jlist(:), Rlist(:,:)
566 : real(dp), intent(in) :: vallist(:,:)
567 : integer :: idx
568 4 : real(dp) :: bivallist(3,3, n)
569 :
570 2 : if (xmpi_comm_rank(xmpi_world)==0) then
571 678 : bivallist(:,:,:)=0.0d0
572 54 : do idx = 1, n, 1
573 52 : bivallist(1,1,idx)=vallist(1, idx)
574 52 : bivallist(2,2,idx)=vallist(2, idx)
575 54 : bivallist(3,3,idx)=vallist(3, idx)
576 : end do
577 2 : call self%set_bilinear(n,ilist,jlist,Rlist,bivallist)
578 : endif
579 2 : end subroutine set_exchange
580 :
581 :
582 : !-------------------------------------------------------------------!
583 : ! set the DMI term.
584 : ! here vallist is a list(n) of 3-vectors.
585 : !-------------------------------------------------------------------!
586 0 : subroutine set_dmi(self, n, ilist, jlist, Rlist, vallist)
587 : class(spin_primitive_potential_t), intent(inout) :: self
588 : integer, intent(in) :: n, ilist(:), jlist(:), Rlist(:,:)
589 : real(dp), intent(in) :: vallist(:,:)
590 : integer :: idx
591 0 : real(dp) :: bivallist(3,3, n), D(3)
592 :
593 0 : if (xmpi_comm_rank(xmpi_world)==0) then
594 0 : bivallist(:,:,:)=0.0d0
595 0 : do idx=1,n, 1
596 0 : D(:)=vallist(:, idx)
597 : ! 0 Dz -Dy
598 : ! -Dz 0 Dx
599 : ! Dy -Dx 0
600 : bivallist(:,:, idx)=reshape ( (/0.0d0, -D(3), D(2), &
601 : D(3), 0.0d0, -D(1), &
602 0 : -D(2), D(1), 0.0d0 /),(/3,3/) )
603 : end do
604 0 : call self%set_bilinear(n,ilist,jlist,Rlist,bivallist)
605 : endif
606 0 : end subroutine set_dmi
607 :
608 : !-------------------------------------------------------------------!
609 : ! set_sia:
610 : ! set a list of single ion anisotropy
611 : ! k1list: amplitudes mat(n)
612 : ! k1dirlist: directions mat(3, n)
613 : !-------------------------------------------------------------------!
614 0 : subroutine set_sia(self, n, ilist, k1list, k1dirlist)
615 :
616 : class(spin_primitive_potential_t), intent(inout) :: self
617 : integer, intent(in) :: n, ilist(:)
618 : real(dp), intent(in) :: k1list(:), k1dirlist(:, :)
619 0 : integer :: idx, Rlist(3, n)
620 0 : real(dp) :: bivallist(3,3, n)
621 0 : if (xmpi_comm_rank(xmpi_world)==0) then
622 0 : bivallist(:,:,:)=0.0d0
623 0 : Rlist(:, :)=0
624 0 : do idx=1,n, 1
625 : bivallist(:,:, idx)= (- k1list(idx))* &
626 0 : outer_product(k1dirlist(:,idx), k1dirlist(:, idx))
627 :
628 : end do
629 0 : call self%set_bilinear(n,ilist,ilist,Rlist,bivallist)
630 : endif
631 0 : end subroutine set_sia
632 :
633 : !-------------------------------------------------------------------!
634 : ! add a SIA for every spin, usually from a user input.
635 : ! input_sia_k1amp: amplitude of SIA, a scalar
636 : ! input_sia_k1dir: direction of SIA, a vector
637 : !-------------------------------------------------------------------!
638 :
639 0 : subroutine add_input_sia(self, input_sia_k1amp, input_sia_k1dir)
640 : class(spin_primitive_potential_t), intent(inout) :: self
641 : real(dp), intent(in):: input_sia_k1amp, input_sia_k1dir(3)
642 0 : integer :: in_sia_ind(self%nspin)
643 0 : real(dp):: in_sia_k1amp(self%nspin), in_sia_k1dir(3, self%nspin)
644 :
645 : integer :: i
646 :
647 0 : if (xmpi_comm_rank(xmpi_world)==0) then
648 0 : write(std_out,'(A28)') "Adding SIA terms from input"
649 0 : do i =1, self%nspin
650 0 : in_sia_ind(i)=i
651 0 : in_sia_k1amp(i)=input_sia_k1amp
652 0 : in_sia_k1dir(:,i)=input_sia_k1dir
653 : end do
654 0 : call self%set_sia(self%nspin, in_sia_ind, in_sia_k1amp, in_sia_k1dir )
655 : endif
656 0 : end subroutine add_input_sia
657 :
658 :
659 : !-------------------------------------------------------------------!
660 : ! Read potential from xml file
661 : ! Inputs:
662 : ! xml_fname: filename
663 : ! use_exchange: whether to read exchange term
664 : ! use_dmi: whether to read DMI term
665 : ! use_sia: whether to read SIA term
666 : ! use_bi: whether to read bilinear term (added on top of other terms.)
667 : !-------------------------------------------------------------------!
668 0 : subroutine read_xml(self, xml_fname, use_exchange, use_dmi, use_sia, use_bi)
669 : class(spin_primitive_potential_t), intent(inout) :: self
670 : character(kind=C_CHAR) :: xml_fname(*)
671 : integer :: natoms, nspin, exc_nnz, dmi_nnz, uni_nnz, bi_nnz
672 : logical, optional, intent(in) :: use_exchange, use_dmi, use_sia, use_bi
673 : logical :: uexc, udmi, usia, ubi
674 : real(dp) :: ref_energy
675 :
676 : type(c_ptr) :: p_unitcell, &
677 : p_masses, p_index_spin, p_gyroratios, p_damping_factors, p_positions, p_spinat, &
678 : p_exc_ilist, p_exc_jlist, p_exc_Rlist, p_exc_vallist, &
679 : p_dmi_ilist, p_dmi_jlist, p_dmi_Rlist, p_dmi_vallist, &
680 : p_uni_ilist, p_uni_amplitude_list, p_uni_direction_list, &
681 : p_bi_ilist, p_bi_jlist, p_bi_Rlist, p_bi_vallist
682 :
683 : real(dp), target :: dummy_real(1)
684 : integer(c_int),target :: dummy_int(1)
685 :
686 : integer(c_int),pointer :: index_spin(:)=>null() ,&
687 : exc_ilist(:)=>null(), exc_jlist(:)=>null(), exc_Rlist(:)=>null(), &
688 : dmi_ilist(:)=>null(), dmi_jlist(:)=>null(), dmi_Rlist(:)=>null(), &
689 : bi_ilist(:)=>null(), bi_jlist(:)=>null(), bi_Rlist(:)=>null(), &
690 : uni_ilist(:)=>null()
691 :
692 : real(c_double), pointer:: unitcell(:)=>null(), masses(:)=>null(), &
693 : gyroratios(:)=>null(), damping_factors(:)=>null(), &
694 : positions(:)=>null(), spinat(:)=>null(), &
695 : exc_vallist(:)=>null(), dmi_vallist(:)=>null(), &
696 : uni_amplitude_list(:)=>null(), uni_direction_list(:)=>null(), &
697 : bi_vallist(:)=>null()
698 :
699 :
700 : real(dp) :: uc(3,3)
701 :
702 : integer :: master, my_rank, comm, nproc
703 : logical :: iam_master
704 0 : call init_mpi_info(master, iam_master, my_rank, comm, nproc)
705 :
706 : ! associate the fortran pointers with the dummy variables
707 0 : if(.not. iam_master) then
708 0 : index_spin=>dummy_int
709 0 : exc_ilist=>dummy_int
710 0 : exc_jlist=>dummy_int
711 0 : exc_Rlist=>dummy_int
712 0 : exc_vallist=>dummy_real
713 0 : dmi_ilist=>dummy_int
714 0 : dmi_jlist=>dummy_int
715 0 : dmi_Rlist=>dummy_int
716 0 : dmi_vallist=>dummy_real
717 0 : uni_ilist=>dummy_int
718 0 : uni_amplitude_list=>dummy_real
719 0 : uni_direction_list=>dummy_real
720 0 : bi_ilist=>dummy_int
721 0 : bi_jlist=>dummy_int
722 0 : bi_Rlist=>dummy_int
723 0 : bi_vallist=>dummy_real
724 0 : unitcell=>dummy_real
725 0 : masses=>dummy_real
726 0 : gyroratios=>dummy_real
727 0 : damping_factors=>dummy_real
728 0 : positions=>dummy_real
729 0 : spinat=>dummy_real
730 : endif
731 :
732 0 : if (iam_master) then
733 0 : write(std_out,'(A58)') "Reading parameters from xml file and setting up spin model"
734 0 : write(std_out,'(A80)') " "
735 : call xml_read_spin(xml_fname, ref_energy, p_unitcell, &
736 : natoms, p_masses, nspin, p_index_spin, p_gyroratios, p_damping_factors, p_positions, p_spinat, &
737 : exc_nnz, p_exc_ilist, p_exc_jlist, p_exc_Rlist, p_exc_vallist, &
738 : dmi_nnz, p_dmi_ilist, p_dmi_jlist, p_dmi_Rlist, p_dmi_vallist, &
739 : uni_nnz, p_uni_ilist, p_uni_amplitude_list, p_uni_direction_list, &
740 0 : bi_nnz, p_bi_ilist, p_bi_jlist, p_bi_Rlist, p_bi_vallist)
741 0 : call c_f_pointer(p_unitcell, unitcell, [9])
742 0 : call c_f_pointer(p_masses, masses, [natoms])
743 0 : call c_f_pointer(p_index_spin, index_spin, [natoms])
744 0 : call c_f_pointer(p_gyroratios, gyroratios, [nspin])
745 0 : call c_f_pointer(p_damping_factors, damping_factors, [nspin])
746 0 : call c_f_pointer(p_positions, positions, [natoms*3])
747 0 : call c_f_pointer(p_spinat, spinat, [natoms*3])
748 0 : call c_f_pointer(p_exc_ilist, exc_ilist, [exc_nnz])
749 0 : call c_f_pointer(p_exc_jlist, exc_jlist, [exc_nnz])
750 0 : call c_f_pointer(p_exc_Rlist, exc_Rlist, [exc_nnz*3])
751 0 : call c_f_pointer(p_exc_vallist, exc_vallist, [exc_nnz*3])
752 0 : call c_f_pointer(p_dmi_ilist, dmi_ilist, [dmi_nnz])
753 0 : call c_f_pointer(p_dmi_jlist, dmi_jlist, [dmi_nnz])
754 0 : call c_f_pointer(p_dmi_Rlist, dmi_Rlist, [dmi_nnz*3])
755 0 : call c_f_pointer(p_dmi_vallist, dmi_vallist, [dmi_nnz*3])
756 0 : call c_f_pointer(p_uni_ilist, uni_ilist, [uni_nnz])
757 0 : call c_f_pointer(p_uni_amplitude_list, uni_amplitude_list, [uni_nnz])
758 0 : call c_f_pointer(p_uni_direction_list, uni_direction_list, [uni_nnz*3])
759 0 : call c_f_pointer(p_bi_ilist, bi_ilist, [bi_nnz])
760 0 : call c_f_pointer(p_bi_jlist, bi_jlist, [bi_nnz])
761 0 : call c_f_pointer(p_bi_Rlist, bi_Rlist, [bi_nnz*3])
762 0 : call c_f_pointer(p_bi_vallist, bi_vallist, [bi_nnz*9])
763 :
764 : ! change of units to a.u.
765 :
766 : ! unitcell already Bohr
767 :
768 : !gyroratios already in a.u. (unit=1)
769 :
770 : ! masses already in a.u.
771 :
772 : ! J, DMI, k1, bi are in eV
773 0 : exc_vallist(:) =exc_vallist(:) * eV_Ha
774 0 : dmi_vallist(:) = dmi_vallist(:) * eV_Ha
775 0 : uni_amplitude_list(:) = uni_amplitude_list(:) * eV_Ha
776 0 : bi_vallist(:) = bi_vallist(:) * eV_Ha
777 :
778 0 : write(std_out,'(A80)') " "
779 0 : write(std_out,'(A21)') "Setting up spin model"
780 0 : write(std_out,'(A15)') "Setting system"
781 0 : uc(:,:)=transpose(reshape(unitcell, [3,3]))
782 : !call set_atoms(self,)
783 : endif
784 :
785 : ! (MPI) Only this runs on non-master node
786 : call self%set_spin_primcell(natoms, uc, positions, &
787 0 : nspin, index_spin, spinat, gyroratios, damping_factors )
788 :
789 0 : if (iam_master) then
790 0 : if(.not. present(use_exchange)) then
791 : uexc=.True.
792 : else
793 0 : uexc=use_exchange
794 : end if
795 :
796 0 : if(uexc .and. exc_nnz>0) then
797 0 : write(std_out,'(A23)') "Setting exchange terms"
798 : call self%set_exchange(exc_nnz,exc_ilist,exc_jlist,&
799 : reshape(exc_Rlist, (/3, exc_nnz /)), &
800 0 : reshape(exc_vallist, (/3, exc_nnz/)))
801 : else
802 0 : if (.not. uexc) write(std_out, '(A38)') " Exchange term from xml file not used."
803 : endif
804 :
805 0 : if(.not. present(use_dmi)) then
806 : udmi=.True.
807 : else
808 0 : udmi=use_dmi
809 : end if
810 0 : if (udmi .and. dmi_nnz>0) then
811 0 : write(std_out,'(A19)') "Setting DMI terms."
812 : call self%set_dmi( n=dmi_nnz, ilist=dmi_ilist, jlist=dmi_jlist, &
813 : Rlist=reshape(dmi_Rlist, (/3, dmi_nnz /)), &
814 0 : vallist = reshape(dmi_vallist, (/3, dmi_nnz/)))
815 : else
816 0 : if (.not. udmi) write(std_out, '(A35)') " DMI term from xml file not used."
817 : end if
818 :
819 0 : if(.not. present(use_sia)) then
820 : usia=.True.
821 : else
822 0 : usia=use_sia
823 : end if
824 0 : if (usia .and. uni_nnz>0) then
825 0 : write(std_out,'(A18)') "Setting SIA terms"
826 : call self%set_sia(uni_nnz, uni_ilist, uni_amplitude_list, &
827 0 : reshape(uni_direction_list, [3, uni_nnz]) )
828 : else
829 0 : if(.not. usia) write(std_out,'(A34)') " SIA term in xml file not used."
830 : end if
831 :
832 0 : if(.not. present(use_bi)) then
833 : ubi=.True.
834 : else
835 0 : ubi=use_bi
836 : endif
837 0 : if (ubi .and. bi_nnz>0) then
838 0 : write(std_out,'(A23)') "Setting bilinear terms."
839 : call self%set_bilinear(bi_nnz, bi_ilist, bi_jlist, &
840 : Rlist=reshape(bi_Rlist, (/3, bi_nnz /)), &
841 0 : vallist = reshape(bi_vallist, (/3,3, bi_nnz/)))
842 : else
843 0 : if(.not. ubi) write(std_out, '(A38)') " Bilinear term in xml file not used."
844 : endif
845 : endif
846 :
847 0 : if (iam_master) then
848 : call xml_free_spin(xml_fname, ref_energy, p_unitcell, &
849 : natoms, p_masses, nspin, p_index_spin, p_gyroratios, p_damping_factors, p_positions, p_spinat, &
850 : exc_nnz, p_exc_ilist, p_exc_jlist, p_exc_Rlist, p_exc_vallist, &
851 : dmi_nnz, p_dmi_ilist, p_dmi_jlist, p_dmi_Rlist, p_dmi_vallist, &
852 : uni_nnz, p_uni_ilist, p_uni_amplitude_list, p_uni_direction_list, &
853 0 : bi_nnz, p_bi_ilist, p_bi_jlist, p_bi_Rlist, p_bi_vallist)
854 : endif
855 :
856 0 : end subroutine read_xml
857 :
858 : !-------------------------------------------------------------------!
859 : ! fill_supercell:
860 : ! generate a supercell potential from primitive potential
861 : ! Input:
862 : ! scmaker: supercell maker helper class
863 : ! scpot: supercell potential (a pointer to a abstract potential)
864 : !-------------------------------------------------------------------!
865 2 : subroutine fill_supercell(self, scmaker, params, scpot, supercell)
866 : class(spin_primitive_potential_t) , intent(inout) :: self
867 : type(supercell_maker_t), intent(inout) :: scmaker
868 : type(multibinit_dtset_type), intent(inout) :: params
869 : class(abstract_potential_t), pointer, intent(inout) :: scpot
870 : type(mbsupercell_t), target :: supercell
871 :
872 : integer :: nspin, sc_nspin, i, R(3), ind_Rij(3), iR, ii, ij, inz
873 : integer :: master, my_rank, comm, nproc, ierr
874 2 : integer, allocatable :: i_sc(:), j_sc(:), Rj_sc(:, :)
875 : logical :: iam_master
876 4 : real(dp) :: val_sc(scmaker%ncells)
877 :
878 2 : ABI_UNUSED_A(params)
879 :
880 2 : call init_mpi_info(master, iam_master, my_rank, comm, nproc)
881 :
882 2 : nspin=self%nspin
883 2 : sc_nspin= nspin * scmaker%ncells
884 2 : call xmpi_bcast(sc_nspin, master, comm, ierr)
885 : !ABI_MALLOC_SCALAR(spin_potential_t::scpot)
886 2 : ABI_MALLOC_TYPE_SCALAR(spin_potential_t, scpot)
887 : select type(scpot) ! use select type because properties only defined for spin_potential is used.
888 : type is (spin_potential_t)
889 2 : call scpot%initialize(sc_nspin)
890 2 : call scpot%set_supercell(supercell)
891 4 : if (iam_master) then
892 2 : call self%coeff%sum_duplicates()
893 158 : do inz=1, self%coeff%nnz
894 156 : ind_Rij=self%coeff%get_ind_inz(inz)
895 156 : iR=ind_Rij(1)
896 156 : ii=ind_Rij(2)
897 156 : ij=ind_Rij(3)
898 624 : R=self%Rlist%data(:,iR)
899 156 : call scmaker%trans_i(nbasis=nspin*3, i=ii, i_sc=i_sc)
900 156 : call scmaker%trans_j_and_Rj(nbasis=nspin*3, j=ij, Rj=R, j_sc=j_sc, Rj_sc=Rj_sc)
901 33852 : val_sc(:)= self%coeff%val%data(inz)
902 33852 : do i=1, scmaker%ncells
903 33852 : call scpot%add_bilinear_term(i_sc(i), j_sc(i), val_sc(i))
904 : end do
905 156 : ABI_SFREE(i_sc)
906 156 : ABI_SFREE(j_sc)
907 158 : ABI_SFREE(Rj_sc)
908 : end do
909 : endif
910 : end select
911 2 : ABI_UNUSED_A(params)
912 4 : end subroutine fill_supercell
913 :
914 : !-------------------------------------------------------------------!
915 : ! check if a string1 ends with string2.
916 : ! used to check if file is .nc or .xml
917 : !-------------------------------------------------------------------!
918 4 : function endswith(string1, string2) result(answer)
919 : character(len=*), intent(in) :: string1
920 : character(len=*), intent(in) :: string2
921 : logical :: answer
922 4 : answer = .False.
923 4 : if(len(string2)>len(string1)) return
924 4 : if(string1(len(string1)-len(string2)+1:)==string2) answer = .True.
925 : end function endswith
926 :
927 :
928 8 : end module m_spin_primitive_potential
|
