Branch data 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
+ + - + -
+ - + - +
- + - + ]
|
