Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief Empirical interatomic potentials for Silicon
10 : !> \note
11 : !> Stefan Goedecker's OpenMP implementation of Bazant's EDIP & Lenosky's
12 : !> empirical interatomic potentials for Silicon.
13 : !> \par History
14 : !> 03.2006 initial create [tdk]
15 : !> \author Thomas D. Kuehne (tkuehne@cp2k.org)
16 : ! **************************************************************************************************
17 : MODULE eip_silicon
18 : USE atomic_kind_list_types, ONLY: atomic_kind_list_type
19 : USE atomic_kind_types, ONLY: atomic_kind_type,&
20 : get_atomic_kind
21 : USE cell_types, ONLY: cell_type,&
22 : get_cell
23 : USE cp_log_handling, ONLY: cp_get_default_logger,&
24 : cp_logger_type
25 : USE cp_output_handling, ONLY: cp_p_file,&
26 : cp_print_key_finished_output,&
27 : cp_print_key_should_output,&
28 : cp_print_key_unit_nr
29 : USE cp_subsys_types, ONLY: cp_subsys_get,&
30 : cp_subsys_type
31 : USE distribution_1d_types, ONLY: distribution_1d_type
32 : USE eip_environment_types, ONLY: eip_env_get,&
33 : eip_environment_type
34 : USE input_section_types, ONLY: section_vals_get_subs_vals,&
35 : section_vals_type
36 : USE kinds, ONLY: dp
37 : USE mathconstants, ONLY: pi
38 : USE message_passing, ONLY: mp_para_env_type
39 : USE particle_types, ONLY: particle_type
40 : USE physcon, ONLY: angstrom,&
41 : evolt
42 :
43 : !$ USE OMP_LIB, ONLY: omp_get_max_threads, omp_get_thread_num, omp_get_num_threads
44 : #include "./base/base_uses.f90"
45 :
46 : IMPLICIT NONE
47 : PRIVATE
48 :
49 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'eip_silicon'
50 :
51 : ! *** Public subroutines ***
52 : PUBLIC :: eip_bazant, eip_lenosky, eip_stillinger_weber, eip_tersoff
53 :
54 : !***
55 :
56 : CONTAINS
57 :
58 : ! **************************************************************************************************
59 : !> \brief Interface routine of Goedecker's Bazant EDIP to CP2K
60 : !> \param eip_env ...
61 : !> \par Literature
62 : !> http://www-math.mit.edu/~bazant/EDIP
63 : !> M.Z. Bazant & E. Kaxiras: Modeling of Covalent Bonding in Solids by
64 : !> Inversion of Cohesive Energy Curves;
65 : !> Phys. Rev. Lett. 77, 4370 (1996)
66 : !> M.Z. Bazant, E. Kaxiras and J.F. Justo: Environment-dependent interatomic
67 : !> potential for bulk silicon;
68 : !> Phys. Rev. B 56, 8542-8552 (1997)
69 : !> S. Goedecker: Optimization and parallelization of a force field for silicon
70 : !> using OpenMP; CPC 148, 1 (2002)
71 : !> \par History
72 : !> 03.2006 initial create [tdk]
73 : !> \author Thomas D. Kuehne (tkuehne@cp2k.org)
74 : ! **************************************************************************************************
75 22 : SUBROUTINE eip_bazant(eip_env)
76 : TYPE(eip_environment_type), POINTER :: eip_env
77 :
78 : CHARACTER(len=*), PARAMETER :: routineN = 'eip_bazant'
79 :
80 : INTEGER :: handle, i, iparticle, iparticle_kind, &
81 : iparticle_local, iw, natom, &
82 : nparticle_kind, nparticle_local
83 : REAL(KIND=dp) :: ekin, ener, ener_var, mass
84 22 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: rxyz
85 : REAL(KIND=dp), DIMENSION(3) :: abc
86 : TYPE(atomic_kind_list_type), POINTER :: atomic_kinds
87 22 : TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
88 : TYPE(atomic_kind_type), POINTER :: atomic_kind
89 : TYPE(cell_type), POINTER :: cell
90 : TYPE(cp_logger_type), POINTER :: logger
91 : TYPE(cp_subsys_type), POINTER :: subsys
92 : TYPE(distribution_1d_type), POINTER :: local_particles
93 : TYPE(mp_para_env_type), POINTER :: para_env
94 22 : TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
95 : TYPE(section_vals_type), POINTER :: eip_section
96 :
97 : ! ------------------------------------------------------------------------
98 :
99 22 : CALL timeset(routineN, handle)
100 :
101 22 : NULLIFY (cell, particle_set, eip_section, logger, atomic_kinds, &
102 22 : atomic_kind, local_particles, subsys, atomic_kind_set, para_env)
103 :
104 22 : ekin = 0.0_dp
105 :
106 22 : logger => cp_get_default_logger()
107 :
108 22 : CPASSERT(ASSOCIATED(eip_env))
109 :
110 : CALL eip_env_get(eip_env=eip_env, cell=cell, particle_set=particle_set, &
111 : subsys=subsys, local_particles=local_particles, &
112 22 : atomic_kind_set=atomic_kind_set)
113 22 : CALL get_cell(cell=cell, abc=abc)
114 :
115 22 : eip_section => section_vals_get_subs_vals(eip_env%force_env_input, "EIP")
116 22 : natom = SIZE(particle_set)
117 : !natom = local_particles%n_el(1)
118 :
119 66 : ALLOCATE (rxyz(3, natom))
120 :
121 22022 : DO i = 1, natom
122 : !iparticle = local_particles%list(1)%array(i)
123 88022 : rxyz(:, i) = particle_set(i)%r(:)*angstrom
124 : END DO
125 :
126 : CALL eip_bazant_silicon(nat=natom, alat=abc*angstrom, rxyz0=rxyz, &
127 : fxyz=eip_env%eip_forces, ener=ener, &
128 : coord=eip_env%coord_avg, ener_var=ener_var, &
129 88 : coord_var=eip_env%coord_var, count=eip_env%count)
130 :
131 : !CALL get_part_ke(md_env, tbmd_energy%E_kinetic, int_grp=globalenv%para_env)
132 22 : CALL cp_subsys_get(subsys=subsys, atomic_kinds=atomic_kinds)
133 :
134 22 : nparticle_kind = atomic_kinds%n_els
135 :
136 44 : DO iparticle_kind = 1, nparticle_kind
137 22 : atomic_kind => atomic_kind_set(iparticle_kind)
138 22 : CALL get_atomic_kind(atomic_kind=atomic_kind, mass=mass)
139 22 : nparticle_local = local_particles%n_el(iparticle_kind)
140 11044 : DO iparticle_local = 1, nparticle_local
141 11000 : iparticle = local_particles%list(iparticle_kind)%array(iparticle_local)
142 : ekin = ekin + 0.5_dp*mass* &
143 : (particle_set(iparticle)%v(1)*particle_set(iparticle)%v(1) &
144 : + particle_set(iparticle)%v(2)*particle_set(iparticle)%v(2) &
145 11022 : + particle_set(iparticle)%v(3)*particle_set(iparticle)%v(3))
146 : END DO
147 : END DO
148 :
149 : ! sum all contributions to energy over calculated parts on all processors
150 22 : CALL cp_subsys_get(subsys=subsys, para_env=para_env)
151 22 : CALL para_env%sum(ekin)
152 22 : eip_env%eip_kinetic_energy = ekin
153 :
154 22 : eip_env%eip_potential_energy = ener/evolt
155 22 : eip_env%eip_energy = eip_env%eip_kinetic_energy + eip_env%eip_potential_energy
156 22 : eip_env%eip_energy_var = ener_var/evolt
157 :
158 22022 : DO i = 1, natom
159 176022 : particle_set(i)%f(:) = eip_env%eip_forces(:, i)/evolt*angstrom
160 : END DO
161 :
162 22 : DEALLOCATE (rxyz)
163 :
164 : ! Print
165 22 : IF (BTEST(cp_print_key_should_output(logger%iter_info, &
166 : eip_section, "PRINT%ENERGIES"), cp_p_file)) THEN
167 : iw = cp_print_key_unit_nr(logger, eip_section, "PRINT%ENERGIES", &
168 0 : extension=".mmLog")
169 :
170 0 : CALL eip_print_energies(eip_env=eip_env, output_unit=iw)
171 : CALL cp_print_key_finished_output(iw, logger, eip_section, &
172 0 : "PRINT%ENERGIES")
173 : END IF
174 :
175 22 : IF (BTEST(cp_print_key_should_output(logger%iter_info, &
176 : eip_section, "PRINT%ENERGIES_VAR"), cp_p_file)) THEN
177 : iw = cp_print_key_unit_nr(logger, eip_section, "PRINT%ENERGIES_VAR", &
178 0 : extension=".mmLog")
179 :
180 0 : CALL eip_print_energy_var(eip_env=eip_env, output_unit=iw)
181 : CALL cp_print_key_finished_output(iw, logger, eip_section, &
182 0 : "PRINT%ENERGIES_VAR")
183 : END IF
184 :
185 22 : IF (BTEST(cp_print_key_should_output(logger%iter_info, &
186 : eip_section, "PRINT%FORCES"), cp_p_file)) THEN
187 : iw = cp_print_key_unit_nr(logger, eip_section, "PRINT%FORCES", &
188 0 : extension=".mmLog")
189 :
190 0 : CALL eip_print_forces(eip_env=eip_env, output_unit=iw)
191 : CALL cp_print_key_finished_output(iw, logger, eip_section, &
192 0 : "PRINT%FORCES")
193 : END IF
194 :
195 22 : IF (BTEST(cp_print_key_should_output(logger%iter_info, &
196 : eip_section, "PRINT%COORD_AVG"), cp_p_file)) THEN
197 : iw = cp_print_key_unit_nr(logger, eip_section, "PRINT%COORD_AVG", &
198 0 : extension=".mmLog")
199 :
200 0 : CALL eip_print_coord_avg(eip_env=eip_env, output_unit=iw)
201 : CALL cp_print_key_finished_output(iw, logger, eip_section, &
202 0 : "PRINT%COORD_AVG")
203 : END IF
204 :
205 22 : IF (BTEST(cp_print_key_should_output(logger%iter_info, &
206 : eip_section, "PRINT%COORD_VAR"), cp_p_file)) THEN
207 : iw = cp_print_key_unit_nr(logger, eip_section, "PRINT%COORD_VAR", &
208 0 : extension=".mmLog")
209 :
210 0 : CALL eip_print_coord_var(eip_env=eip_env, output_unit=iw)
211 : CALL cp_print_key_finished_output(iw, logger, eip_section, &
212 0 : "PRINT%COORD_VAR")
213 : END IF
214 :
215 22 : IF (BTEST(cp_print_key_should_output(logger%iter_info, &
216 : eip_section, "PRINT%COUNT"), cp_p_file)) THEN
217 : iw = cp_print_key_unit_nr(logger, eip_section, "PRINT%COUNT", &
218 0 : extension=".mmLog")
219 :
220 0 : CALL eip_print_count(eip_env=eip_env, output_unit=iw)
221 : CALL cp_print_key_finished_output(iw, logger, eip_section, &
222 0 : "PRINT%COUNT")
223 : END IF
224 :
225 22 : CALL timestop(handle)
226 :
227 22 : END SUBROUTINE eip_bazant
228 :
229 : ! **************************************************************************************************
230 : !> \brief Interface routine of Goedecker's Lenosky force field to CP2K
231 : !> \param eip_env ...
232 : !> \par Literature
233 : !> T. Lenosky, et. al.: Highly optimized empirical potential model of silicon;
234 : !> Modelling Simul. Sci. Eng., 8 (2000)
235 : !> S. Goedecker: Optimization and parallelization of a force field for silicon
236 : !> using OpenMP; CPC 148, 1 (2002)
237 : !> \par History
238 : !> 03.2006 initial create [tdk]
239 : !> \author Thomas D. Kuehne (tkuehne@cp2k.org)
240 : ! **************************************************************************************************
241 22 : SUBROUTINE eip_lenosky(eip_env)
242 : TYPE(eip_environment_type), POINTER :: eip_env
243 :
244 : CHARACTER(len=*), PARAMETER :: routineN = 'eip_lenosky'
245 :
246 : INTEGER :: handle, i, iparticle, iparticle_kind, &
247 : iparticle_local, iw, natom, &
248 : nparticle_kind, nparticle_local
249 : REAL(KIND=dp) :: ekin, ener, ener_var, mass
250 22 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: rxyz
251 : REAL(KIND=dp), DIMENSION(3) :: abc
252 : TYPE(atomic_kind_list_type), POINTER :: atomic_kinds
253 22 : TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
254 : TYPE(atomic_kind_type), POINTER :: atomic_kind
255 : TYPE(cell_type), POINTER :: cell
256 : TYPE(cp_logger_type), POINTER :: logger
257 : TYPE(cp_subsys_type), POINTER :: subsys
258 : TYPE(distribution_1d_type), POINTER :: local_particles
259 : TYPE(mp_para_env_type), POINTER :: para_env
260 22 : TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
261 : TYPE(section_vals_type), POINTER :: eip_section
262 :
263 : ! ------------------------------------------------------------------------
264 :
265 22 : CALL timeset(routineN, handle)
266 :
267 22 : NULLIFY (cell, particle_set, eip_section, logger, atomic_kinds, &
268 22 : atomic_kind, local_particles, subsys, atomic_kind_set, para_env)
269 :
270 22 : ekin = 0.0_dp
271 :
272 22 : logger => cp_get_default_logger()
273 :
274 22 : CPASSERT(ASSOCIATED(eip_env))
275 :
276 : CALL eip_env_get(eip_env=eip_env, cell=cell, particle_set=particle_set, &
277 : subsys=subsys, local_particles=local_particles, &
278 22 : atomic_kind_set=atomic_kind_set)
279 22 : CALL get_cell(cell=cell, abc=abc)
280 :
281 22 : eip_section => section_vals_get_subs_vals(eip_env%force_env_input, "EIP")
282 22 : natom = SIZE(particle_set)
283 : !natom = local_particles%n_el(1)
284 :
285 66 : ALLOCATE (rxyz(3, natom))
286 :
287 22022 : DO i = 1, natom
288 : !iparticle = local_particles%list(1)%array(i)
289 88022 : rxyz(:, i) = particle_set(i)%r(:)*angstrom
290 : END DO
291 :
292 : CALL eip_lenosky_silicon(nat=natom, alat=abc*angstrom, rxyz0=rxyz, &
293 : fxyz=eip_env%eip_forces, ener=ener, &
294 : coord=eip_env%coord_avg, ener_var=ener_var, &
295 88 : coord_var=eip_env%coord_var, count=eip_env%count)
296 :
297 : !CALL get_part_ke(md_env, tbmd_energy%E_kinetic, int_grp=globalenv%para_env)
298 22 : CALL cp_subsys_get(subsys=subsys, atomic_kinds=atomic_kinds)
299 :
300 22 : nparticle_kind = atomic_kinds%n_els
301 :
302 44 : DO iparticle_kind = 1, nparticle_kind
303 22 : atomic_kind => atomic_kind_set(iparticle_kind)
304 22 : CALL get_atomic_kind(atomic_kind=atomic_kind, mass=mass)
305 22 : nparticle_local = local_particles%n_el(iparticle_kind)
306 11044 : DO iparticle_local = 1, nparticle_local
307 11000 : iparticle = local_particles%list(iparticle_kind)%array(iparticle_local)
308 : ekin = ekin + 0.5_dp*mass* &
309 : (particle_set(iparticle)%v(1)*particle_set(iparticle)%v(1) &
310 : + particle_set(iparticle)%v(2)*particle_set(iparticle)%v(2) &
311 11022 : + particle_set(iparticle)%v(3)*particle_set(iparticle)%v(3))
312 : END DO
313 : END DO
314 :
315 : ! sum all contributions to energy over calculated parts on all processors
316 22 : CALL cp_subsys_get(subsys=subsys, para_env=para_env)
317 22 : CALL para_env%sum(ekin)
318 22 : eip_env%eip_kinetic_energy = ekin
319 :
320 22 : eip_env%eip_potential_energy = ener/evolt
321 22 : eip_env%eip_energy = eip_env%eip_kinetic_energy + eip_env%eip_potential_energy
322 22 : eip_env%eip_energy_var = ener_var/evolt
323 :
324 22022 : DO i = 1, natom
325 176022 : particle_set(i)%f(:) = eip_env%eip_forces(:, i)/evolt*angstrom
326 : END DO
327 :
328 22 : DEALLOCATE (rxyz)
329 :
330 : ! Print
331 22 : IF (BTEST(cp_print_key_should_output(logger%iter_info, &
332 : eip_section, "PRINT%ENERGIES"), cp_p_file)) THEN
333 : iw = cp_print_key_unit_nr(logger, eip_section, "PRINT%ENERGIES", &
334 0 : extension=".mmLog")
335 :
336 0 : CALL eip_print_energies(eip_env=eip_env, output_unit=iw)
337 : CALL cp_print_key_finished_output(iw, logger, eip_section, &
338 0 : "PRINT%ENERGIES")
339 : END IF
340 :
341 22 : IF (BTEST(cp_print_key_should_output(logger%iter_info, &
342 : eip_section, "PRINT%ENERGIES_VAR"), cp_p_file)) THEN
343 : iw = cp_print_key_unit_nr(logger, eip_section, "PRINT%ENERGIES_VAR", &
344 0 : extension=".mmLog")
345 :
346 0 : CALL eip_print_energy_var(eip_env=eip_env, output_unit=iw)
347 : CALL cp_print_key_finished_output(iw, logger, eip_section, &
348 0 : "PRINT%ENERGIES_VAR")
349 : END IF
350 :
351 22 : IF (BTEST(cp_print_key_should_output(logger%iter_info, &
352 : eip_section, "PRINT%FORCES"), cp_p_file)) THEN
353 : iw = cp_print_key_unit_nr(logger, eip_section, "PRINT%FORCES", &
354 0 : extension=".mmLog")
355 :
356 0 : CALL eip_print_forces(eip_env=eip_env, output_unit=iw)
357 : CALL cp_print_key_finished_output(iw, logger, eip_section, &
358 0 : "PRINT%FORCES")
359 : END IF
360 :
361 22 : IF (BTEST(cp_print_key_should_output(logger%iter_info, &
362 : eip_section, "PRINT%COORD_AVG"), cp_p_file)) THEN
363 : iw = cp_print_key_unit_nr(logger, eip_section, "PRINT%COORD_AVG", &
364 0 : extension=".mmLog")
365 :
366 0 : CALL eip_print_coord_avg(eip_env=eip_env, output_unit=iw)
367 : CALL cp_print_key_finished_output(iw, logger, eip_section, &
368 0 : "PRINT%COORD_AVG")
369 : END IF
370 :
371 22 : IF (BTEST(cp_print_key_should_output(logger%iter_info, &
372 : eip_section, "PRINT%COORD_VAR"), cp_p_file)) THEN
373 : iw = cp_print_key_unit_nr(logger, eip_section, "PRINT%COORD_VAR", &
374 0 : extension=".mmLog")
375 :
376 0 : CALL eip_print_coord_var(eip_env=eip_env, output_unit=iw)
377 : CALL cp_print_key_finished_output(iw, logger, eip_section, &
378 0 : "PRINT%COORD_VAR")
379 : END IF
380 :
381 22 : IF (BTEST(cp_print_key_should_output(logger%iter_info, &
382 : eip_section, "PRINT%COUNT"), cp_p_file)) THEN
383 : iw = cp_print_key_unit_nr(logger, eip_section, "PRINT%COUNT", &
384 0 : extension=".mmLog")
385 :
386 0 : CALL eip_print_count(eip_env=eip_env, output_unit=iw)
387 : CALL cp_print_key_finished_output(iw, logger, eip_section, &
388 0 : "PRINT%COUNT")
389 : END IF
390 :
391 22 : CALL timestop(handle)
392 :
393 22 : END SUBROUTINE eip_lenosky
394 :
395 : ! **************************************************************************************************
396 : !> \brief Interface routine of the Stillinger-Weber force field to CP2K
397 : !> \param eip_env ...
398 : !> \par Literature
399 : !> F.H. Stillinger and T.A. Weber:
400 : !> Computer simulation of local order in condensed phases of silicon;
401 : !> Phys. Rev. B 31, 5262 (1985)
402 : !> \par History
403 : !> 04.2026 added [Thomas D. Kuehne, tkuehne@cp2k.org]
404 : ! **************************************************************************************************
405 22 : SUBROUTINE eip_stillinger_weber(eip_env)
406 : TYPE(eip_environment_type), POINTER :: eip_env
407 :
408 : CHARACTER(len=*), PARAMETER :: routineN = 'eip_stillinger_weber'
409 :
410 : INTEGER :: handle, i, iparticle, iparticle_kind, &
411 : iparticle_local, iw, natom, &
412 : nparticle_kind, nparticle_local
413 : REAL(KIND=dp) :: ekin, ener, mass
414 22 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: rxyz
415 : REAL(KIND=dp), DIMENSION(3) :: abc
416 : TYPE(atomic_kind_list_type), POINTER :: atomic_kinds
417 22 : TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
418 : TYPE(atomic_kind_type), POINTER :: atomic_kind
419 : TYPE(cell_type), POINTER :: cell
420 : TYPE(cp_logger_type), POINTER :: logger
421 : TYPE(cp_subsys_type), POINTER :: subsys
422 : TYPE(distribution_1d_type), POINTER :: local_particles
423 : TYPE(mp_para_env_type), POINTER :: para_env
424 22 : TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
425 : TYPE(section_vals_type), POINTER :: eip_section
426 :
427 22 : CALL timeset(routineN, handle)
428 :
429 22 : NULLIFY (cell, particle_set, eip_section, logger, atomic_kinds, &
430 22 : atomic_kind, local_particles, subsys, atomic_kind_set, para_env)
431 :
432 22 : ekin = 0.0_dp
433 :
434 22 : logger => cp_get_default_logger()
435 :
436 22 : CPASSERT(ASSOCIATED(eip_env))
437 :
438 : CALL eip_env_get(eip_env=eip_env, cell=cell, particle_set=particle_set, &
439 : subsys=subsys, local_particles=local_particles, &
440 22 : atomic_kind_set=atomic_kind_set)
441 22 : CALL get_cell(cell=cell, abc=abc)
442 :
443 22 : eip_section => section_vals_get_subs_vals(eip_env%force_env_input, "EIP")
444 22 : natom = SIZE(particle_set)
445 :
446 66 : ALLOCATE (rxyz(3, natom))
447 :
448 22022 : DO i = 1, natom
449 88022 : rxyz(:, i) = particle_set(i)%r(:)*angstrom
450 : END DO
451 :
452 : CALL eip_stillinger_weber_silicon(nat=natom, alat=abc*angstrom, &
453 : rxyz0=rxyz, fxyz=eip_env%eip_forces, &
454 88 : etot=ener, count=eip_env%count)
455 :
456 22 : eip_env%coord_avg = 0.0_dp
457 22 : eip_env%coord_var = 0.0_dp
458 :
459 22 : CALL cp_subsys_get(subsys=subsys, atomic_kinds=atomic_kinds)
460 :
461 22 : nparticle_kind = atomic_kinds%n_els
462 :
463 44 : DO iparticle_kind = 1, nparticle_kind
464 22 : atomic_kind => atomic_kind_set(iparticle_kind)
465 22 : CALL get_atomic_kind(atomic_kind=atomic_kind, mass=mass)
466 22 : nparticle_local = local_particles%n_el(iparticle_kind)
467 11044 : DO iparticle_local = 1, nparticle_local
468 11000 : iparticle = local_particles%list(iparticle_kind)%array(iparticle_local)
469 : ekin = ekin + 0.5_dp*mass* &
470 : (particle_set(iparticle)%v(1)*particle_set(iparticle)%v(1) &
471 : + particle_set(iparticle)%v(2)*particle_set(iparticle)%v(2) &
472 11022 : + particle_set(iparticle)%v(3)*particle_set(iparticle)%v(3))
473 : END DO
474 : END DO
475 :
476 22 : CALL cp_subsys_get(subsys=subsys, para_env=para_env)
477 22 : CALL para_env%sum(ekin)
478 22 : eip_env%eip_kinetic_energy = ekin
479 :
480 22 : eip_env%eip_potential_energy = ener/evolt
481 22 : eip_env%eip_energy = eip_env%eip_kinetic_energy + eip_env%eip_potential_energy
482 22 : eip_env%eip_energy_var = 0.0_dp
483 :
484 22022 : DO i = 1, natom
485 176022 : particle_set(i)%f(:) = eip_env%eip_forces(:, i)/evolt*angstrom
486 : END DO
487 :
488 22 : DEALLOCATE (rxyz)
489 :
490 22 : IF (BTEST(cp_print_key_should_output(logger%iter_info, &
491 : eip_section, "PRINT%ENERGIES"), cp_p_file)) THEN
492 : iw = cp_print_key_unit_nr(logger, eip_section, "PRINT%ENERGIES", &
493 0 : extension=".mmLog")
494 :
495 0 : CALL eip_print_energies(eip_env=eip_env, output_unit=iw)
496 : CALL cp_print_key_finished_output(iw, logger, eip_section, &
497 0 : "PRINT%ENERGIES")
498 : END IF
499 :
500 22 : IF (BTEST(cp_print_key_should_output(logger%iter_info, &
501 : eip_section, "PRINT%ENERGIES_VAR"), cp_p_file)) THEN
502 : iw = cp_print_key_unit_nr(logger, eip_section, "PRINT%ENERGIES_VAR", &
503 0 : extension=".mmLog")
504 :
505 0 : CALL eip_print_energy_var(eip_env=eip_env, output_unit=iw)
506 : CALL cp_print_key_finished_output(iw, logger, eip_section, &
507 0 : "PRINT%ENERGIES_VAR")
508 : END IF
509 :
510 22 : IF (BTEST(cp_print_key_should_output(logger%iter_info, &
511 : eip_section, "PRINT%FORCES"), cp_p_file)) THEN
512 : iw = cp_print_key_unit_nr(logger, eip_section, "PRINT%FORCES", &
513 0 : extension=".mmLog")
514 :
515 0 : CALL eip_print_forces(eip_env=eip_env, output_unit=iw)
516 : CALL cp_print_key_finished_output(iw, logger, eip_section, &
517 0 : "PRINT%FORCES")
518 : END IF
519 :
520 22 : IF (BTEST(cp_print_key_should_output(logger%iter_info, &
521 : eip_section, "PRINT%COORD_AVG"), cp_p_file)) THEN
522 : iw = cp_print_key_unit_nr(logger, eip_section, "PRINT%COORD_AVG", &
523 0 : extension=".mmLog")
524 :
525 0 : CALL eip_print_coord_avg(eip_env=eip_env, output_unit=iw)
526 : CALL cp_print_key_finished_output(iw, logger, eip_section, &
527 0 : "PRINT%COORD_AVG")
528 : END IF
529 :
530 22 : IF (BTEST(cp_print_key_should_output(logger%iter_info, &
531 : eip_section, "PRINT%COORD_VAR"), cp_p_file)) THEN
532 : iw = cp_print_key_unit_nr(logger, eip_section, "PRINT%COORD_VAR", &
533 0 : extension=".mmLog")
534 :
535 0 : CALL eip_print_coord_var(eip_env=eip_env, output_unit=iw)
536 : CALL cp_print_key_finished_output(iw, logger, eip_section, &
537 0 : "PRINT%COORD_VAR")
538 : END IF
539 :
540 22 : IF (BTEST(cp_print_key_should_output(logger%iter_info, &
541 : eip_section, "PRINT%COUNT"), cp_p_file)) THEN
542 : iw = cp_print_key_unit_nr(logger, eip_section, "PRINT%COUNT", &
543 0 : extension=".mmLog")
544 :
545 0 : CALL eip_print_count(eip_env=eip_env, output_unit=iw)
546 : CALL cp_print_key_finished_output(iw, logger, eip_section, &
547 0 : "PRINT%COUNT")
548 : END IF
549 :
550 22 : CALL timestop(handle)
551 :
552 22 : END SUBROUTINE eip_stillinger_weber
553 :
554 : ! **************************************************************************************************
555 : !> \brief Interface routine of the Tersoff force field to CP2K
556 : !> \param eip_env ...
557 : !> \par Literature
558 : !> J. Tersoff:
559 : !> New empirical approach for the structure and energy of covalent systems;
560 : !> Phys. Rev. Lett. 61, 2879 (1988)
561 : !> J. Tersoff:
562 : !> Modeling solid-state chemistry: Interatomic potentials for multicomponent systems;
563 : !> Phys. Rev. B 39, 5566 (1989)
564 : !> \par History
565 : !> 04.2026 added [Thomas D. Kuehne, tkuehne@cp2k.org]
566 : ! **************************************************************************************************
567 22 : SUBROUTINE eip_tersoff(eip_env)
568 : TYPE(eip_environment_type), POINTER :: eip_env
569 :
570 : CHARACTER(len=*), PARAMETER :: routineN = 'eip_tersoff'
571 :
572 : INTEGER :: handle, i, iparticle, iparticle_kind, &
573 : iparticle_local, iw, natom, &
574 : nparticle_kind, nparticle_local
575 : REAL(KIND=dp) :: ekin, ener, mass
576 22 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: rxyz
577 : REAL(KIND=dp), DIMENSION(3) :: abc
578 : TYPE(atomic_kind_list_type), POINTER :: atomic_kinds
579 22 : TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
580 : TYPE(atomic_kind_type), POINTER :: atomic_kind
581 : TYPE(cell_type), POINTER :: cell
582 : TYPE(cp_logger_type), POINTER :: logger
583 : TYPE(cp_subsys_type), POINTER :: subsys
584 : TYPE(distribution_1d_type), POINTER :: local_particles
585 : TYPE(mp_para_env_type), POINTER :: para_env
586 22 : TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
587 : TYPE(section_vals_type), POINTER :: eip_section
588 :
589 22 : CALL timeset(routineN, handle)
590 :
591 22 : NULLIFY (cell, particle_set, eip_section, logger, atomic_kinds, &
592 22 : atomic_kind, local_particles, subsys, atomic_kind_set, para_env)
593 :
594 22 : ekin = 0.0_dp
595 :
596 22 : logger => cp_get_default_logger()
597 :
598 22 : CPASSERT(ASSOCIATED(eip_env))
599 :
600 : CALL eip_env_get(eip_env=eip_env, cell=cell, particle_set=particle_set, &
601 : subsys=subsys, local_particles=local_particles, &
602 22 : atomic_kind_set=atomic_kind_set)
603 22 : CALL get_cell(cell=cell, abc=abc)
604 :
605 22 : eip_section => section_vals_get_subs_vals(eip_env%force_env_input, "EIP")
606 22 : natom = SIZE(particle_set)
607 :
608 66 : ALLOCATE (rxyz(3, natom))
609 :
610 22022 : DO i = 1, natom
611 88022 : rxyz(:, i) = particle_set(i)%r(:)*angstrom
612 : END DO
613 :
614 : CALL eip_tersoff_silicon(nat=natom, alat=abc*angstrom, rxyz=rxyz, &
615 : fxyz=eip_env%eip_forces, etot=ener, &
616 88 : count=eip_env%count)
617 :
618 22 : eip_env%coord_avg = 0.0_dp
619 22 : eip_env%coord_var = 0.0_dp
620 :
621 22 : CALL cp_subsys_get(subsys=subsys, atomic_kinds=atomic_kinds)
622 :
623 22 : nparticle_kind = atomic_kinds%n_els
624 :
625 44 : DO iparticle_kind = 1, nparticle_kind
626 22 : atomic_kind => atomic_kind_set(iparticle_kind)
627 22 : CALL get_atomic_kind(atomic_kind=atomic_kind, mass=mass)
628 22 : nparticle_local = local_particles%n_el(iparticle_kind)
629 11044 : DO iparticle_local = 1, nparticle_local
630 11000 : iparticle = local_particles%list(iparticle_kind)%array(iparticle_local)
631 : ekin = ekin + 0.5_dp*mass* &
632 : (particle_set(iparticle)%v(1)*particle_set(iparticle)%v(1) &
633 : + particle_set(iparticle)%v(2)*particle_set(iparticle)%v(2) &
634 11022 : + particle_set(iparticle)%v(3)*particle_set(iparticle)%v(3))
635 : END DO
636 : END DO
637 :
638 22 : CALL cp_subsys_get(subsys=subsys, para_env=para_env)
639 22 : CALL para_env%sum(ekin)
640 22 : eip_env%eip_kinetic_energy = ekin
641 :
642 22 : eip_env%eip_potential_energy = ener/evolt
643 22 : eip_env%eip_energy = eip_env%eip_kinetic_energy + eip_env%eip_potential_energy
644 22 : eip_env%eip_energy_var = 0.0_dp
645 :
646 22022 : DO i = 1, natom
647 176022 : particle_set(i)%f(:) = eip_env%eip_forces(:, i)/evolt*angstrom
648 : END DO
649 :
650 22 : DEALLOCATE (rxyz)
651 :
652 22 : IF (BTEST(cp_print_key_should_output(logger%iter_info, &
653 : eip_section, "PRINT%ENERGIES"), cp_p_file)) THEN
654 : iw = cp_print_key_unit_nr(logger, eip_section, "PRINT%ENERGIES", &
655 0 : extension=".mmLog")
656 :
657 0 : CALL eip_print_energies(eip_env=eip_env, output_unit=iw)
658 : CALL cp_print_key_finished_output(iw, logger, eip_section, &
659 0 : "PRINT%ENERGIES")
660 : END IF
661 :
662 22 : IF (BTEST(cp_print_key_should_output(logger%iter_info, &
663 : eip_section, "PRINT%ENERGIES_VAR"), cp_p_file)) THEN
664 : iw = cp_print_key_unit_nr(logger, eip_section, "PRINT%ENERGIES_VAR", &
665 0 : extension=".mmLog")
666 :
667 0 : CALL eip_print_energy_var(eip_env=eip_env, output_unit=iw)
668 : CALL cp_print_key_finished_output(iw, logger, eip_section, &
669 0 : "PRINT%ENERGIES_VAR")
670 : END IF
671 :
672 22 : IF (BTEST(cp_print_key_should_output(logger%iter_info, &
673 : eip_section, "PRINT%FORCES"), cp_p_file)) THEN
674 : iw = cp_print_key_unit_nr(logger, eip_section, "PRINT%FORCES", &
675 0 : extension=".mmLog")
676 :
677 0 : CALL eip_print_forces(eip_env=eip_env, output_unit=iw)
678 : CALL cp_print_key_finished_output(iw, logger, eip_section, &
679 0 : "PRINT%FORCES")
680 : END IF
681 :
682 22 : IF (BTEST(cp_print_key_should_output(logger%iter_info, &
683 : eip_section, "PRINT%COORD_AVG"), cp_p_file)) THEN
684 : iw = cp_print_key_unit_nr(logger, eip_section, "PRINT%COORD_AVG", &
685 0 : extension=".mmLog")
686 :
687 0 : CALL eip_print_coord_avg(eip_env=eip_env, output_unit=iw)
688 : CALL cp_print_key_finished_output(iw, logger, eip_section, &
689 0 : "PRINT%COORD_AVG")
690 : END IF
691 :
692 22 : IF (BTEST(cp_print_key_should_output(logger%iter_info, &
693 : eip_section, "PRINT%COORD_VAR"), cp_p_file)) THEN
694 : iw = cp_print_key_unit_nr(logger, eip_section, "PRINT%COORD_VAR", &
695 0 : extension=".mmLog")
696 :
697 0 : CALL eip_print_coord_var(eip_env=eip_env, output_unit=iw)
698 : CALL cp_print_key_finished_output(iw, logger, eip_section, &
699 0 : "PRINT%COORD_VAR")
700 : END IF
701 :
702 22 : IF (BTEST(cp_print_key_should_output(logger%iter_info, &
703 : eip_section, "PRINT%COUNT"), cp_p_file)) THEN
704 : iw = cp_print_key_unit_nr(logger, eip_section, "PRINT%COUNT", &
705 0 : extension=".mmLog")
706 :
707 0 : CALL eip_print_count(eip_env=eip_env, output_unit=iw)
708 : CALL cp_print_key_finished_output(iw, logger, eip_section, &
709 0 : "PRINT%COUNT")
710 : END IF
711 :
712 22 : CALL timestop(handle)
713 :
714 22 : END SUBROUTINE eip_tersoff
715 :
716 : ! **************************************************************************************************
717 : !> \brief Print routine for the EIP energies
718 : !> \param eip_env The eip environment of matter
719 : !> \param output_unit The output unit
720 : !> \par History
721 : !> 03.2006 initial create [tdk]
722 : !> \author Thomas D. Kuehne (tkuehne@cp2k.org)
723 : !> \note
724 : !> As usual the EIP energies differ from the DFT energies!
725 : !> Only the relative energy differences are correctly reproduced.
726 : ! **************************************************************************************************
727 0 : SUBROUTINE eip_print_energies(eip_env, output_unit)
728 : TYPE(eip_environment_type), POINTER :: eip_env
729 : INTEGER, INTENT(IN) :: output_unit
730 :
731 : ! ------------------------------------------------------------------------
732 :
733 0 : IF (output_unit > 0) THEN
734 : WRITE (UNIT=output_unit, FMT="(/,(T3,A,T55,F25.14))") &
735 0 : "Kinetic energy [Hartree]: ", eip_env%eip_kinetic_energy, &
736 0 : "Potential energy [Hartree]: ", eip_env%eip_potential_energy, &
737 0 : "Total EIP energy [Hartree]: ", eip_env%eip_energy
738 : END IF
739 :
740 0 : END SUBROUTINE eip_print_energies
741 :
742 : ! **************************************************************************************************
743 : !> \brief Print routine for the variance of the energy/atom
744 : !> \param eip_env The eip environment of matter
745 : !> \param output_unit The output unit
746 : !> \par History
747 : !> 03.2006 initial create [tdk]
748 : !> \author Thomas D. Kuehne (tkuehne@cp2k.org)
749 : ! **************************************************************************************************
750 0 : SUBROUTINE eip_print_energy_var(eip_env, output_unit)
751 : TYPE(eip_environment_type), POINTER :: eip_env
752 : INTEGER, INTENT(IN) :: output_unit
753 :
754 : INTEGER :: unit_nr
755 :
756 : ! ------------------------------------------------------------------------
757 :
758 0 : unit_nr = output_unit
759 :
760 0 : IF (unit_nr > 0) THEN
761 :
762 0 : WRITE (unit_nr, *) ""
763 0 : WRITE (unit_nr, *) "The variance of the EIP energy/atom!"
764 0 : WRITE (unit_nr, *) ""
765 0 : WRITE (unit_nr, *) eip_env%eip_energy_var
766 :
767 : END IF
768 :
769 0 : END SUBROUTINE eip_print_energy_var
770 :
771 : ! **************************************************************************************************
772 : !> \brief Print routine for the forces
773 : !> \param eip_env The eip environment of matter
774 : !> \param output_unit The output unit
775 : !> \par History
776 : !> 03.2006 initial create [tdk]
777 : !> \author Thomas D. Kuehne (tkuehne@cp2k.org)
778 : ! **************************************************************************************************
779 0 : SUBROUTINE eip_print_forces(eip_env, output_unit)
780 : TYPE(eip_environment_type), POINTER :: eip_env
781 : INTEGER, INTENT(IN) :: output_unit
782 :
783 : INTEGER :: iatom, natom, unit_nr
784 0 : TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
785 :
786 : ! ------------------------------------------------------------------------
787 :
788 0 : NULLIFY (particle_set)
789 :
790 0 : unit_nr = output_unit
791 :
792 0 : IF (unit_nr > 0) THEN
793 :
794 0 : CALL eip_env_get(eip_env=eip_env, particle_set=particle_set)
795 :
796 0 : natom = SIZE(particle_set)
797 :
798 0 : WRITE (unit_nr, *) ""
799 0 : WRITE (unit_nr, *) "The EIP forces!"
800 0 : WRITE (unit_nr, *) ""
801 0 : WRITE (unit_nr, *) "Total EIP forces [Hartree/Bohr]"
802 0 : DO iatom = 1, natom
803 0 : WRITE (unit_nr, *) eip_env%eip_forces(1:3, iatom)
804 : END DO
805 :
806 : END IF
807 :
808 0 : END SUBROUTINE eip_print_forces
809 :
810 : ! **************************************************************************************************
811 : !> \brief Print routine for the average coordination number
812 : !> \param eip_env The eip environment of matter
813 : !> \param output_unit The output unit
814 : !> \par History
815 : !> 03.2006 initial create [tdk]
816 : !> \author Thomas D. Kuehne (tkuehne@cp2k.org)
817 : ! **************************************************************************************************
818 0 : SUBROUTINE eip_print_coord_avg(eip_env, output_unit)
819 : TYPE(eip_environment_type), POINTER :: eip_env
820 : INTEGER, INTENT(IN) :: output_unit
821 :
822 : INTEGER :: unit_nr
823 :
824 : ! ------------------------------------------------------------------------
825 :
826 0 : unit_nr = output_unit
827 :
828 0 : IF (unit_nr > 0) THEN
829 :
830 0 : WRITE (unit_nr, *) ""
831 0 : WRITE (unit_nr, *) "The average coordination number!"
832 0 : WRITE (unit_nr, *) ""
833 0 : WRITE (unit_nr, *) eip_env%coord_avg
834 :
835 : END IF
836 :
837 0 : END SUBROUTINE eip_print_coord_avg
838 :
839 : ! **************************************************************************************************
840 : !> \brief Print routine for the variance of the coordination number
841 : !> \param eip_env The eip environment of matter
842 : !> \param output_unit The output unit
843 : !> \par History
844 : !> 03.2006 initial create [tdk]
845 : !> \author Thomas D. Kuehne (tkuehne@cp2k.org)
846 : ! **************************************************************************************************
847 0 : SUBROUTINE eip_print_coord_var(eip_env, output_unit)
848 : TYPE(eip_environment_type), POINTER :: eip_env
849 : INTEGER, INTENT(IN) :: output_unit
850 :
851 : INTEGER :: unit_nr
852 :
853 : ! ------------------------------------------------------------------------
854 :
855 0 : unit_nr = output_unit
856 :
857 0 : IF (unit_nr > 0) THEN
858 :
859 0 : WRITE (unit_nr, *) ""
860 0 : WRITE (unit_nr, *) "The variance of the coordination number!"
861 0 : WRITE (unit_nr, *) ""
862 0 : WRITE (unit_nr, *) eip_env%coord_var
863 :
864 : END IF
865 :
866 0 : END SUBROUTINE eip_print_coord_var
867 :
868 : ! **************************************************************************************************
869 : !> \brief Print routine for the function call counter
870 : !> \param eip_env The eip environment of matter
871 : !> \param output_unit The output unit
872 : !> \par History
873 : !> 03.2006 initial create [tdk]
874 : !> \author Thomas D. Kuehne (tkuehne@cp2k.org)
875 : ! **************************************************************************************************
876 0 : SUBROUTINE eip_print_count(eip_env, output_unit)
877 : TYPE(eip_environment_type), POINTER :: eip_env
878 : INTEGER, INTENT(IN) :: output_unit
879 :
880 : INTEGER :: unit_nr
881 :
882 : ! ------------------------------------------------------------------------
883 :
884 0 : unit_nr = output_unit
885 :
886 0 : IF (unit_nr > 0) THEN
887 :
888 0 : WRITE (unit_nr, *) ""
889 0 : WRITE (unit_nr, *) "The function call counter!"
890 0 : WRITE (unit_nr, *) ""
891 0 : WRITE (unit_nr, *) eip_env%count
892 :
893 : END IF
894 :
895 0 : END SUBROUTINE eip_print_count
896 :
897 : ! **************************************************************************************************
898 : !> \brief Bazant's EDIP (environment-dependent interatomic potential) for Silicon
899 : !> by Stefan Goedecker
900 : !> \param nat number of atoms
901 : !> \param alat lattice constants of the orthorombic box containing the particles
902 : !> \param rxyz0 atomic positions in Angstrom, may be modified on output.
903 : !> If an atom is outside the box the program will bring it back
904 : !> into the box by translations through alat
905 : !> \param fxyz forces in eV/A
906 : !> \param ener total energy in eV
907 : !> \param coord average coordination number
908 : !> \param ener_var variance of the energy/atom
909 : !> \param coord_var variance of the coordination number
910 : !> \param count count is increased by one per call, has to be initialized
911 : !> to 0.e0_dp before first call of eip_bazant
912 : !> \par Literature
913 : !> http://www-math.mit.edu/~bazant/EDIP
914 : !> M.Z. Bazant & E. Kaxiras: Modeling of Covalent Bonding in Solids by
915 : !> Inversion of Cohesive Energy Curves;
916 : !> Phys. Rev. Lett. 77, 4370 (1996)
917 : !> M.Z. Bazant, E. Kaxiras and J.F. Justo: Environment-dependent interatomic
918 : !> potential for bulk silicon;
919 : !> Phys. Rev. B 56, 8542-8552 (1997)
920 : !> S. Goedecker: Optimization and parallelization of a force field for silicon
921 : !> using OpenMP; CPC 148, 1 (2002)
922 : !> \par History
923 : !> 03.2006 initial create [tdk]
924 : !> \author Thomas D. Kuehne (tkuehne@cp2k.org)
925 : ! **************************************************************************************************
926 22 : SUBROUTINE eip_bazant_silicon(nat, alat, rxyz0, fxyz, ener, coord, ener_var, &
927 : coord_var, count)
928 :
929 : INTEGER :: nat
930 : REAL(KIND=dp) :: alat(3), rxyz0(3, nat), fxyz(3, nat), &
931 : ener, coord, ener_var, coord_var, count
932 :
933 : INTEGER :: i, iam, iat, iat1, iat2, ii, il, in, indlst, indlstx, istop, istopg, l1, l2, l3, &
934 : laymx, ll1, ll2, ll3, lot, max_nbrs, myspace, myspaceout, ncx, nn, nnbrx, npr
935 22 : INTEGER, ALLOCATABLE, DIMENSION(:) :: lay, lstb, num2, num3, numz
936 22 : INTEGER, ALLOCATABLE, DIMENSION(:, :) :: lsta
937 22 : INTEGER, ALLOCATABLE, DIMENSION(:, :, :, :) :: icell
938 : REAL(KIND=dp) :: coord2, cut, cut2, ener2, rlc1i, rlc2i, &
939 : rlc3i, tcoord, tcoord2, tener, tener2
940 22 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: rel, rxyz, s2, s3, sz, txyz
941 :
942 : ! cut=par_a
943 22 : cut = 3.1213820e0_dp + 1.e-14_dp
944 :
945 22 : IF (count == 0) OPEN (unit=10, file='bazant.mon', status='unknown')
946 22 : count = count + 1.e0_dp
947 :
948 : ! linear scaling calculation of verlet list
949 22 : ll1 = INT(alat(1)/cut)
950 22 : IF (ll1 < 1) CPABORT("alat(1) too small")
951 22 : ll2 = INT(alat(2)/cut)
952 22 : IF (ll2 < 1) CPABORT("alat(2) too small")
953 22 : ll3 = INT(alat(3)/cut)
954 22 : IF (ll3 < 1) CPABORT("alat(3) too small")
955 :
956 : ! determine number of threads
957 22 : npr = 1
958 22 : !$OMP PARALLEL PRIVATE(iam) SHARED (npr) DEFAULT(NONE)
959 : !$ iam = omp_get_thread_num()
960 : !$ if (iam .eq. 0) npr = omp_get_num_threads()
961 : !$OMP END PARALLEL
962 :
963 : ! linear scaling calculation of verlet list
964 :
965 22 : IF (npr <= 1) THEN !serial if too few processors to gain by parallelizing
966 :
967 : ! set ncx for serial case, ncx for parallel case set below
968 22 : ncx = 16
969 0 : loop_ncx_s: DO
970 132 : ALLOCATE (icell(0:ncx, -1:ll1, -1:ll2, -1:ll3))
971 24442 : icell(0, -1:ll1, -1:ll2, -1:ll3) = 0
972 22 : rlc1i = ll1/alat(1)
973 22 : rlc2i = ll2/alat(2)
974 22 : rlc3i = ll3/alat(3)
975 :
976 22022 : loop_iat_s: DO iat = 1, nat
977 22000 : rxyz0(1, iat) = MODULO(MODULO(rxyz0(1, iat), alat(1)), alat(1))
978 22000 : rxyz0(2, iat) = MODULO(MODULO(rxyz0(2, iat), alat(2)), alat(2))
979 22000 : rxyz0(3, iat) = MODULO(MODULO(rxyz0(3, iat), alat(3)), alat(3))
980 22000 : l1 = INT(rxyz0(1, iat)*rlc1i)
981 22000 : l2 = INT(rxyz0(2, iat)*rlc2i)
982 22000 : l3 = INT(rxyz0(3, iat)*rlc3i)
983 :
984 22000 : ii = icell(0, l1, l2, l3)
985 22000 : ii = ii + 1
986 22000 : icell(0, l1, l2, l3) = ii
987 22000 : IF (ii > ncx) THEN
988 0 : WRITE (10, *) count, 'NCX too small', ncx
989 0 : DEALLOCATE (icell)
990 0 : ncx = ncx*2
991 : CYCLE loop_ncx_s
992 : END IF
993 22022 : icell(ii, l1, l2, l3) = iat
994 : END DO loop_iat_s
995 : EXIT loop_ncx_s
996 : END DO loop_ncx_s
997 :
998 : ELSE ! parallel case
999 :
1000 : ! periodization of particles can be done in parallel
1001 0 : !$OMP PARALLEL DO SHARED (alat,nat,rxyz0) PRIVATE(iat) DEFAULT(NONE)
1002 : DO iat = 1, nat
1003 : rxyz0(1, iat) = MODULO(MODULO(rxyz0(1, iat), alat(1)), alat(1))
1004 : rxyz0(2, iat) = MODULO(MODULO(rxyz0(2, iat), alat(2)), alat(2))
1005 : rxyz0(3, iat) = MODULO(MODULO(rxyz0(3, iat), alat(3)), alat(3))
1006 : END DO
1007 : !$OMP END PARALLEL DO
1008 :
1009 : ! assignment to cell is done serially
1010 : ! set ncx for parallel case, ncx for serial case set above
1011 0 : ncx = 16
1012 0 : loop_ncx_p: DO
1013 0 : ALLOCATE (icell(0:ncx, -1:ll1, -1:ll2, -1:ll3))
1014 0 : icell(0, -1:ll1, -1:ll2, -1:ll3) = 0
1015 :
1016 0 : rlc1i = ll1/alat(1)
1017 0 : rlc2i = ll2/alat(2)
1018 0 : rlc3i = ll3/alat(3)
1019 :
1020 0 : loop_iat_p: DO iat = 1, nat
1021 0 : l1 = INT(rxyz0(1, iat)*rlc1i)
1022 0 : l2 = INT(rxyz0(2, iat)*rlc2i)
1023 0 : l3 = INT(rxyz0(3, iat)*rlc3i)
1024 0 : ii = icell(0, l1, l2, l3)
1025 0 : ii = ii + 1
1026 0 : icell(0, l1, l2, l3) = ii
1027 0 : IF (ii > ncx) THEN
1028 0 : WRITE (10, *) count, 'NCX too small', ncx
1029 0 : DEALLOCATE (icell)
1030 0 : ncx = ncx*2
1031 : CYCLE loop_ncx_p
1032 : END IF
1033 0 : icell(ii, l1, l2, l3) = iat
1034 : END DO loop_iat_p
1035 : EXIT loop_ncx_p
1036 : END DO loop_ncx_p
1037 :
1038 : END IF
1039 :
1040 : ! duplicate all atoms within boundary layer
1041 22 : laymx = ncx*(2*ll1*ll2 + 2*ll1*ll3 + 2*ll2*ll3 + 4*ll1 + 4*ll2 + 4*ll3 + 8)
1042 22 : nn = nat + laymx
1043 110 : ALLOCATE (rxyz(3, nn), lay(nn))
1044 22022 : DO iat = 1, nat
1045 22000 : lay(iat) = iat
1046 22000 : rxyz(1, iat) = rxyz0(1, iat)
1047 22000 : rxyz(2, iat) = rxyz0(2, iat)
1048 22022 : rxyz(3, iat) = rxyz0(3, iat)
1049 : END DO
1050 22 : il = nat
1051 : ! xy plane
1052 198 : DO l2 = 0, ll2 - 1
1053 1606 : DO l1 = 0, ll1 - 1
1054 :
1055 1408 : in = icell(0, l1, l2, 0)
1056 1408 : icell(0, l1, l2, ll3) = in
1057 4126 : DO ii = 1, in
1058 2718 : i = icell(ii, l1, l2, 0)
1059 2718 : il = il + 1
1060 2718 : IF (il > nn) CPABORT("enlarge laymx")
1061 2718 : lay(il) = i
1062 2718 : icell(ii, l1, l2, ll3) = il
1063 2718 : rxyz(1, il) = rxyz(1, i)
1064 2718 : rxyz(2, il) = rxyz(2, i)
1065 4126 : rxyz(3, il) = rxyz(3, i) + alat(3)
1066 : END DO
1067 :
1068 1408 : in = icell(0, l1, l2, ll3 - 1)
1069 1408 : icell(0, l1, l2, -1) = in
1070 4366 : DO ii = 1, in
1071 2782 : i = icell(ii, l1, l2, ll3 - 1)
1072 2782 : il = il + 1
1073 2782 : IF (il > nn) CPABORT("enlarge laymx")
1074 2782 : lay(il) = i
1075 2782 : icell(ii, l1, l2, -1) = il
1076 2782 : rxyz(1, il) = rxyz(1, i)
1077 2782 : rxyz(2, il) = rxyz(2, i)
1078 4190 : rxyz(3, il) = rxyz(3, i) - alat(3)
1079 : END DO
1080 :
1081 : END DO
1082 : END DO
1083 :
1084 : ! yz plane
1085 198 : DO l3 = 0, ll3 - 1
1086 1606 : DO l2 = 0, ll2 - 1
1087 :
1088 1408 : in = icell(0, 0, l2, l3)
1089 1408 : icell(0, ll1, l2, l3) = in
1090 4194 : DO ii = 1, in
1091 2786 : i = icell(ii, 0, l2, l3)
1092 2786 : il = il + 1
1093 2786 : IF (il > nn) CPABORT("enlarge laymx")
1094 2786 : lay(il) = i
1095 2786 : icell(ii, ll1, l2, l3) = il
1096 2786 : rxyz(1, il) = rxyz(1, i) + alat(1)
1097 2786 : rxyz(2, il) = rxyz(2, i)
1098 4194 : rxyz(3, il) = rxyz(3, i)
1099 : END DO
1100 :
1101 1408 : in = icell(0, ll1 - 1, l2, l3)
1102 1408 : icell(0, -1, l2, l3) = in
1103 4298 : DO ii = 1, in
1104 2714 : i = icell(ii, ll1 - 1, l2, l3)
1105 2714 : il = il + 1
1106 2714 : IF (il > nn) CPABORT("enlarge laymx")
1107 2714 : lay(il) = i
1108 2714 : icell(ii, -1, l2, l3) = il
1109 2714 : rxyz(1, il) = rxyz(1, i) - alat(1)
1110 2714 : rxyz(2, il) = rxyz(2, i)
1111 4122 : rxyz(3, il) = rxyz(3, i)
1112 : END DO
1113 :
1114 : END DO
1115 : END DO
1116 :
1117 : ! xz plane
1118 198 : DO l3 = 0, ll3 - 1
1119 1606 : DO l1 = 0, ll1 - 1
1120 :
1121 1408 : in = icell(0, l1, 0, l3)
1122 1408 : icell(0, l1, ll2, l3) = in
1123 4264 : DO ii = 1, in
1124 2856 : i = icell(ii, l1, 0, l3)
1125 2856 : il = il + 1
1126 2856 : IF (il > nn) CPABORT("enlarge laymx")
1127 2856 : lay(il) = i
1128 2856 : icell(ii, l1, ll2, l3) = il
1129 2856 : rxyz(1, il) = rxyz(1, i)
1130 2856 : rxyz(2, il) = rxyz(2, i) + alat(2)
1131 4264 : rxyz(3, il) = rxyz(3, i)
1132 : END DO
1133 :
1134 1408 : in = icell(0, l1, ll2 - 1, l3)
1135 1408 : icell(0, l1, -1, l3) = in
1136 4228 : DO ii = 1, in
1137 2644 : i = icell(ii, l1, ll2 - 1, l3)
1138 2644 : il = il + 1
1139 2644 : IF (il > nn) CPABORT("enlarge laymx")
1140 2644 : lay(il) = i
1141 2644 : icell(ii, l1, -1, l3) = il
1142 2644 : rxyz(1, il) = rxyz(1, i)
1143 2644 : rxyz(2, il) = rxyz(2, i) - alat(2)
1144 4052 : rxyz(3, il) = rxyz(3, i)
1145 : END DO
1146 :
1147 : END DO
1148 : END DO
1149 :
1150 : ! x axis
1151 198 : DO l1 = 0, ll1 - 1
1152 :
1153 176 : in = icell(0, l1, 0, 0)
1154 176 : icell(0, l1, ll2, ll3) = in
1155 564 : DO ii = 1, in
1156 388 : i = icell(ii, l1, 0, 0)
1157 388 : il = il + 1
1158 388 : IF (il > nn) CPABORT("enlarge laymx")
1159 388 : lay(il) = i
1160 388 : icell(ii, l1, ll2, ll3) = il
1161 388 : rxyz(1, il) = rxyz(1, i)
1162 388 : rxyz(2, il) = rxyz(2, i) + alat(2)
1163 564 : rxyz(3, il) = rxyz(3, i) + alat(3)
1164 : END DO
1165 :
1166 176 : in = icell(0, l1, 0, ll3 - 1)
1167 176 : icell(0, l1, ll2, -1) = in
1168 488 : DO ii = 1, in
1169 312 : i = icell(ii, l1, 0, ll3 - 1)
1170 312 : il = il + 1
1171 312 : IF (il > nn) CPABORT("enlarge laymx")
1172 312 : lay(il) = i
1173 312 : icell(ii, l1, ll2, -1) = il
1174 312 : rxyz(1, il) = rxyz(1, i)
1175 312 : rxyz(2, il) = rxyz(2, i) + alat(2)
1176 488 : rxyz(3, il) = rxyz(3, i) - alat(3)
1177 : END DO
1178 :
1179 176 : in = icell(0, l1, ll2 - 1, 0)
1180 176 : icell(0, l1, -1, ll3) = in
1181 466 : DO ii = 1, in
1182 290 : i = icell(ii, l1, ll2 - 1, 0)
1183 290 : il = il + 1
1184 290 : IF (il > nn) CPABORT("enlarge laymx")
1185 290 : lay(il) = i
1186 290 : icell(ii, l1, -1, ll3) = il
1187 290 : rxyz(1, il) = rxyz(1, i)
1188 290 : rxyz(2, il) = rxyz(2, i) - alat(2)
1189 466 : rxyz(3, il) = rxyz(3, i) + alat(3)
1190 : END DO
1191 :
1192 176 : in = icell(0, l1, ll2 - 1, ll3 - 1)
1193 176 : icell(0, l1, -1, -1) = in
1194 638 : DO ii = 1, in
1195 440 : i = icell(ii, l1, ll2 - 1, ll3 - 1)
1196 440 : il = il + 1
1197 440 : IF (il > nn) CPABORT("enlarge laymx")
1198 440 : lay(il) = i
1199 440 : icell(ii, l1, -1, -1) = il
1200 440 : rxyz(1, il) = rxyz(1, i)
1201 440 : rxyz(2, il) = rxyz(2, i) - alat(2)
1202 616 : rxyz(3, il) = rxyz(3, i) - alat(3)
1203 : END DO
1204 :
1205 : END DO
1206 :
1207 : ! y axis
1208 198 : DO l2 = 0, ll2 - 1
1209 :
1210 176 : in = icell(0, 0, l2, 0)
1211 176 : icell(0, ll1, l2, ll3) = in
1212 546 : DO ii = 1, in
1213 370 : i = icell(ii, 0, l2, 0)
1214 370 : il = il + 1
1215 370 : IF (il > nn) CPABORT("enlarge laymx")
1216 370 : lay(il) = i
1217 370 : icell(ii, ll1, l2, ll3) = il
1218 370 : rxyz(1, il) = rxyz(1, i) + alat(1)
1219 370 : rxyz(2, il) = rxyz(2, i)
1220 546 : rxyz(3, il) = rxyz(3, i) + alat(3)
1221 : END DO
1222 :
1223 176 : in = icell(0, 0, l2, ll3 - 1)
1224 176 : icell(0, ll1, l2, -1) = in
1225 546 : DO ii = 1, in
1226 370 : i = icell(ii, 0, l2, ll3 - 1)
1227 370 : il = il + 1
1228 370 : IF (il > nn) CPABORT("enlarge laymx")
1229 370 : lay(il) = i
1230 370 : icell(ii, ll1, l2, -1) = il
1231 370 : rxyz(1, il) = rxyz(1, i) + alat(1)
1232 370 : rxyz(2, il) = rxyz(2, i)
1233 546 : rxyz(3, il) = rxyz(3, i) - alat(3)
1234 : END DO
1235 :
1236 176 : in = icell(0, ll1 - 1, l2, 0)
1237 176 : icell(0, -1, l2, ll3) = in
1238 542 : DO ii = 1, in
1239 366 : i = icell(ii, ll1 - 1, l2, 0)
1240 366 : il = il + 1
1241 366 : IF (il > nn) CPABORT("enlarge laymx")
1242 366 : lay(il) = i
1243 366 : icell(ii, -1, l2, ll3) = il
1244 366 : rxyz(1, il) = rxyz(1, i) - alat(1)
1245 366 : rxyz(2, il) = rxyz(2, i)
1246 542 : rxyz(3, il) = rxyz(3, i) + alat(3)
1247 : END DO
1248 :
1249 176 : in = icell(0, ll1 - 1, l2, ll3 - 1)
1250 176 : icell(0, -1, l2, -1) = in
1251 522 : DO ii = 1, in
1252 324 : i = icell(ii, ll1 - 1, l2, ll3 - 1)
1253 324 : il = il + 1
1254 324 : IF (il > nn) CPABORT("enlarge laymx")
1255 324 : lay(il) = i
1256 324 : icell(ii, -1, l2, -1) = il
1257 324 : rxyz(1, il) = rxyz(1, i) - alat(1)
1258 324 : rxyz(2, il) = rxyz(2, i)
1259 500 : rxyz(3, il) = rxyz(3, i) - alat(3)
1260 : END DO
1261 :
1262 : END DO
1263 :
1264 : ! z axis
1265 198 : DO l3 = 0, ll3 - 1
1266 :
1267 176 : in = icell(0, 0, 0, l3)
1268 176 : icell(0, ll1, ll2, l3) = in
1269 556 : DO ii = 1, in
1270 380 : i = icell(ii, 0, 0, l3)
1271 380 : il = il + 1
1272 380 : IF (il > nn) CPABORT("enlarge laymx")
1273 380 : lay(il) = i
1274 380 : icell(ii, ll1, ll2, l3) = il
1275 380 : rxyz(1, il) = rxyz(1, i) + alat(1)
1276 380 : rxyz(2, il) = rxyz(2, i) + alat(2)
1277 556 : rxyz(3, il) = rxyz(3, i)
1278 : END DO
1279 :
1280 176 : in = icell(0, ll1 - 1, 0, l3)
1281 176 : icell(0, -1, ll2, l3) = in
1282 546 : DO ii = 1, in
1283 370 : i = icell(ii, ll1 - 1, 0, l3)
1284 370 : il = il + 1
1285 370 : IF (il > nn) CPABORT("enlarge laymx")
1286 370 : lay(il) = i
1287 370 : icell(ii, -1, ll2, l3) = il
1288 370 : rxyz(1, il) = rxyz(1, i) - alat(1)
1289 370 : rxyz(2, il) = rxyz(2, i) + alat(2)
1290 546 : rxyz(3, il) = rxyz(3, i)
1291 : END DO
1292 :
1293 176 : in = icell(0, 0, ll2 - 1, l3)
1294 176 : icell(0, ll1, -1, l3) = in
1295 522 : DO ii = 1, in
1296 346 : i = icell(ii, 0, ll2 - 1, l3)
1297 346 : il = il + 1
1298 346 : IF (il > nn) CPABORT("enlarge laymx")
1299 346 : lay(il) = i
1300 346 : icell(ii, ll1, -1, l3) = il
1301 346 : rxyz(1, il) = rxyz(1, i) + alat(1)
1302 346 : rxyz(2, il) = rxyz(2, i) - alat(2)
1303 522 : rxyz(3, il) = rxyz(3, i)
1304 : END DO
1305 :
1306 176 : in = icell(0, ll1 - 1, ll2 - 1, l3)
1307 176 : icell(0, -1, -1, l3) = in
1308 532 : DO ii = 1, in
1309 334 : i = icell(ii, ll1 - 1, ll2 - 1, l3)
1310 334 : il = il + 1
1311 334 : IF (il > nn) CPABORT("enlarge laymx")
1312 334 : lay(il) = i
1313 334 : icell(ii, -1, -1, l3) = il
1314 334 : rxyz(1, il) = rxyz(1, i) - alat(1)
1315 334 : rxyz(2, il) = rxyz(2, i) - alat(2)
1316 510 : rxyz(3, il) = rxyz(3, i)
1317 : END DO
1318 :
1319 : END DO
1320 :
1321 : ! corners
1322 22 : in = icell(0, 0, 0, 0)
1323 22 : icell(0, ll1, ll2, ll3) = in
1324 92 : DO ii = 1, in
1325 70 : i = icell(ii, 0, 0, 0)
1326 70 : il = il + 1
1327 70 : IF (il > nn) CPABORT("enlarge laymx")
1328 70 : lay(il) = i
1329 70 : icell(ii, ll1, ll2, ll3) = il
1330 70 : rxyz(1, il) = rxyz(1, i) + alat(1)
1331 70 : rxyz(2, il) = rxyz(2, i) + alat(2)
1332 92 : rxyz(3, il) = rxyz(3, i) + alat(3)
1333 : END DO
1334 :
1335 22 : in = icell(0, ll1 - 1, 0, 0)
1336 22 : icell(0, -1, ll2, ll3) = in
1337 42 : DO ii = 1, in
1338 20 : i = icell(ii, ll1 - 1, 0, 0)
1339 20 : il = il + 1
1340 20 : IF (il > nn) CPABORT("enlarge laymx")
1341 20 : lay(il) = i
1342 20 : icell(ii, -1, ll2, ll3) = il
1343 20 : rxyz(1, il) = rxyz(1, i) - alat(1)
1344 20 : rxyz(2, il) = rxyz(2, i) + alat(2)
1345 42 : rxyz(3, il) = rxyz(3, i) + alat(3)
1346 : END DO
1347 :
1348 22 : in = icell(0, 0, ll2 - 1, 0)
1349 22 : icell(0, ll1, -1, ll3) = in
1350 66 : DO ii = 1, in
1351 44 : i = icell(ii, 0, ll2 - 1, 0)
1352 44 : il = il + 1
1353 44 : IF (il > nn) CPABORT("enlarge laymx")
1354 44 : lay(il) = i
1355 44 : icell(ii, ll1, -1, ll3) = il
1356 44 : rxyz(1, il) = rxyz(1, i) + alat(1)
1357 44 : rxyz(2, il) = rxyz(2, i) - alat(2)
1358 66 : rxyz(3, il) = rxyz(3, i) + alat(3)
1359 : END DO
1360 :
1361 22 : in = icell(0, ll1 - 1, ll2 - 1, 0)
1362 22 : icell(0, -1, -1, ll3) = in
1363 86 : DO ii = 1, in
1364 64 : i = icell(ii, ll1 - 1, ll2 - 1, 0)
1365 64 : il = il + 1
1366 64 : IF (il > nn) CPABORT("enlarge laymx")
1367 64 : lay(il) = i
1368 64 : icell(ii, -1, -1, ll3) = il
1369 64 : rxyz(1, il) = rxyz(1, i) - alat(1)
1370 64 : rxyz(2, il) = rxyz(2, i) - alat(2)
1371 86 : rxyz(3, il) = rxyz(3, i) + alat(3)
1372 : END DO
1373 :
1374 22 : in = icell(0, 0, 0, ll3 - 1)
1375 22 : icell(0, ll1, ll2, -1) = in
1376 66 : DO ii = 1, in
1377 44 : i = icell(ii, 0, 0, ll3 - 1)
1378 44 : il = il + 1
1379 44 : IF (il > nn) CPABORT("enlarge laymx")
1380 44 : lay(il) = i
1381 44 : icell(ii, ll1, ll2, -1) = il
1382 44 : rxyz(1, il) = rxyz(1, i) + alat(1)
1383 44 : rxyz(2, il) = rxyz(2, i) + alat(2)
1384 66 : rxyz(3, il) = rxyz(3, i) - alat(3)
1385 : END DO
1386 :
1387 22 : in = icell(0, ll1 - 1, 0, ll3 - 1)
1388 22 : icell(0, -1, ll2, -1) = in
1389 50 : DO ii = 1, in
1390 28 : i = icell(ii, ll1 - 1, 0, ll3 - 1)
1391 28 : il = il + 1
1392 28 : IF (il > nn) CPABORT("enlarge laymx")
1393 28 : lay(il) = i
1394 28 : icell(ii, -1, ll2, -1) = il
1395 28 : rxyz(1, il) = rxyz(1, i) - alat(1)
1396 28 : rxyz(2, il) = rxyz(2, i) + alat(2)
1397 50 : rxyz(3, il) = rxyz(3, i) - alat(3)
1398 : END DO
1399 :
1400 22 : in = icell(0, 0, ll2 - 1, ll3 - 1)
1401 22 : icell(0, ll1, -1, -1) = in
1402 86 : DO ii = 1, in
1403 64 : i = icell(ii, 0, ll2 - 1, ll3 - 1)
1404 64 : il = il + 1
1405 64 : IF (il > nn) CPABORT("enlarge laymx")
1406 64 : lay(il) = i
1407 64 : icell(ii, ll1, -1, -1) = il
1408 64 : rxyz(1, il) = rxyz(1, i) + alat(1)
1409 64 : rxyz(2, il) = rxyz(2, i) - alat(2)
1410 86 : rxyz(3, il) = rxyz(3, i) - alat(3)
1411 : END DO
1412 :
1413 22 : in = icell(0, ll1 - 1, ll2 - 1, ll3 - 1)
1414 22 : icell(0, -1, -1, -1) = in
1415 62 : DO ii = 1, in
1416 40 : i = icell(ii, ll1 - 1, ll2 - 1, ll3 - 1)
1417 40 : il = il + 1
1418 40 : IF (il > nn) CPABORT("enlarge laymx")
1419 40 : lay(il) = i
1420 40 : icell(ii, -1, -1, -1) = il
1421 40 : rxyz(1, il) = rxyz(1, i) - alat(1)
1422 40 : rxyz(2, il) = rxyz(2, i) - alat(2)
1423 62 : rxyz(3, il) = rxyz(3, i) - alat(3)
1424 : END DO
1425 :
1426 66 : ALLOCATE (lsta(2, nat))
1427 22 : nnbrx = 12
1428 0 : loop_nnbrx: DO
1429 110 : ALLOCATE (lstb(nnbrx*nat), rel(5, nnbrx*nat))
1430 :
1431 22 : indlstx = 0
1432 :
1433 : !$OMP PARALLEL DEFAULT(NONE) &
1434 : !$OMP PRIVATE(iat,cut2,iam,ii,indlst,l1,l2,l3,myspace,npr) &
1435 : !$OMP SHARED (indlstx,nat,nn,nnbrx,ncx,ll1,ll2,ll3,icell,lsta,lstb,lay, &
1436 22 : !$OMP rel,rxyz,cut,myspaceout)
1437 :
1438 : npr = 1
1439 : !$ npr = omp_get_num_threads()
1440 : iam = 0
1441 : !$ iam = omp_get_thread_num()
1442 :
1443 : cut2 = cut**2
1444 : ! assign contiguous portions of the arrays lstb and rel to the threads
1445 : myspace = (nat*nnbrx)/npr
1446 : IF (iam == 0) myspaceout = myspace
1447 : ! Verlet list, relative positions
1448 : indlst = 0
1449 : loop_l3: DO l3 = 0, ll3 - 1
1450 : loop_l2: DO l2 = 0, ll2 - 1
1451 : loop_l1: DO l1 = 0, ll1 - 1
1452 : loop_ii: DO ii = 1, icell(0, l1, l2, l3)
1453 : iat = icell(ii, l1, l2, l3)
1454 : IF (((iat - 1)*npr)/nat == iam) THEN
1455 : ! write(*,*) 'sublstiat:iam,iat',iam,iat
1456 : lsta(1, iat) = iam*myspace + indlst + 1
1457 : CALL sublstiat_b(iat, nn, ncx, ll1, ll2, ll3, l1, l2, l3, myspace, &
1458 : rxyz, icell, lstb(iam*myspace + 1), lay, &
1459 : rel(1, iam*myspace + 1), cut2, indlst)
1460 : lsta(2, iat) = iam*myspace + indlst
1461 : ! write(*,'(a,4(x,i3),100(x,i2))') &
1462 : ! 'iam,iat,lsta',iam,iat,lsta(1,iat),lsta(2,iat), &
1463 : ! (lstb(j),j=lsta(1,iat),lsta(2,iat))
1464 : END IF
1465 : END DO loop_ii
1466 : END DO loop_l1
1467 : END DO loop_l2
1468 : END DO loop_l3
1469 : !$OMP ATOMIC UPDATE
1470 : indlstx = MAX(indlstx, indlst)
1471 : !$OMP END ATOMIC
1472 : !$OMP END PARALLEL
1473 :
1474 22 : IF (indlstx >= myspaceout) THEN
1475 0 : WRITE (10, *) count, 'NNBRX too small', nnbrx
1476 0 : DEALLOCATE (lstb, rel)
1477 0 : nnbrx = 3*nnbrx/2
1478 : CYCLE loop_nnbrx
1479 : END IF
1480 : EXIT loop_nnbrx
1481 : END DO loop_nnbrx
1482 :
1483 22 : istopg = 0
1484 :
1485 : !$OMP PARALLEL DEFAULT(NONE) &
1486 : !$OMP PRIVATE(iam,npr,iat,iat1,iat2,lot,istop,tcoord,tcoord2, &
1487 : !$OMP tener,tener2,txyz,s2,s3,sz,num2,num3,numz,max_nbrs) &
1488 22 : !$OMP SHARED (nat,nnbrx,lsta,lstb,rel,ener,ener2,fxyz,coord,coord2,istopg)
1489 :
1490 : npr = 1
1491 : !$ npr = omp_get_num_threads()
1492 : iam = 0
1493 : !$ iam = omp_get_thread_num()
1494 :
1495 : max_nbrs = 30
1496 :
1497 : IF (npr /= 1) THEN
1498 : ! PARALLEL CASE
1499 : ! create temporary private scalars for reduction sum on energies and
1500 : ! temporary private array for reduction sum on forces
1501 : !$OMP CRITICAL(omp_eip_bazant_silicon)
1502 : ALLOCATE (txyz(3, nat), s2(max_nbrs, 8), s3(max_nbrs, 7), sz(max_nbrs, 6), &
1503 : num2(max_nbrs), num3(max_nbrs), numz(max_nbrs))
1504 : !$OMP END CRITICAL(omp_eip_bazant_silicon)
1505 : IF (iam == 0) THEN
1506 : ener = 0.e0_dp
1507 : ener2 = 0.e0_dp
1508 : coord = 0.e0_dp
1509 : coord2 = 0.e0_dp
1510 : END IF
1511 : !$OMP DO
1512 : DO iat = 1, nat
1513 : fxyz(1, iat) = 0.e0_dp
1514 : fxyz(2, iat) = 0.e0_dp
1515 : fxyz(3, iat) = 0.e0_dp
1516 : END DO
1517 : !$OMP BARRIER
1518 :
1519 : ! Each thread treats at most lot atoms
1520 : lot = INT(REAL(nat, KIND=dp)/REAL(npr, KIND=dp) + .999999999999e0_dp)
1521 : iat1 = iam*lot + 1
1522 : iat2 = MIN((iam + 1)*lot, nat)
1523 : ! write(*,*) 'subfeniat:iat1,iat2,iam',iat1,iat2,iam
1524 : CALL subfeniat_b(iat1, iat2, nat, lsta, lstb, rel, tener, tener2, &
1525 : tcoord, tcoord2, nnbrx, txyz, max_nbrs, istop, &
1526 : s2(1, 1), s2(1, 2), s2(1, 3), s2(1, 4), s2(1, 5), s2(1, 6), s2(1, 7), s2(1, 8), &
1527 : num2, s3(1, 1), s3(1, 2), s3(1, 3), s3(1, 4), s3(1, 5), s3(1, 6), s3(1, 7), &
1528 : num3, sz(1, 1), sz(1, 2), sz(1, 3), sz(1, 4), sz(1, 5), sz(1, 6), numz)
1529 :
1530 : !$OMP CRITICAL(omp_eip_bazant_silicon)
1531 : ener = ener + tener
1532 : ener2 = ener2 + tener2
1533 : coord = coord + tcoord
1534 : coord2 = coord2 + tcoord2
1535 : istopg = istopg + istop
1536 : DO iat = 1, nat
1537 : fxyz(1, iat) = fxyz(1, iat) + txyz(1, iat)
1538 : fxyz(2, iat) = fxyz(2, iat) + txyz(2, iat)
1539 : fxyz(3, iat) = fxyz(3, iat) + txyz(3, iat)
1540 : END DO
1541 : DEALLOCATE (txyz, s2, s3, sz, num2, num3, numz)
1542 : !$OMP END CRITICAL(omp_eip_bazant_silicon)
1543 :
1544 : ELSE
1545 : ! SERIAL CASE
1546 : iat1 = 1
1547 : iat2 = nat
1548 : ALLOCATE (s2(max_nbrs, 8), s3(max_nbrs, 7), sz(max_nbrs, 6), &
1549 : num2(max_nbrs), num3(max_nbrs), numz(max_nbrs))
1550 : CALL subfeniat_b(iat1, iat2, nat, lsta, lstb, rel, ener, ener2, &
1551 : coord, coord2, nnbrx, fxyz, max_nbrs, istopg, &
1552 : s2(1, 1), s2(1, 2), s2(1, 3), s2(1, 4), s2(1, 5), s2(1, 6), s2(1, 7), s2(1, 8), &
1553 : num2, s3(1, 1), s3(1, 2), s3(1, 3), s3(1, 4), s3(1, 5), s3(1, 6), s3(1, 7), &
1554 : num3, sz(1, 1), sz(1, 2), sz(1, 3), sz(1, 4), sz(1, 5), sz(1, 6), numz)
1555 : DEALLOCATE (s2, s3, sz, num2, num3, numz)
1556 :
1557 : END IF
1558 : !$OMP END PARALLEL
1559 :
1560 22 : IF (istopg > 0) CPABORT("DIMENSION ERROR (see WARNING above)")
1561 22 : ener_var = ener2/nat - (ener/nat)**2
1562 22 : coord = coord/nat
1563 22 : coord_var = coord2/nat - coord**2
1564 :
1565 22 : DEALLOCATE (rxyz, icell, lay, lsta, lstb, rel)
1566 :
1567 22 : END SUBROUTINE eip_bazant_silicon
1568 :
1569 : ! **************************************************************************************************
1570 : !> \brief ...
1571 : !> \param iat1 ...
1572 : !> \param iat2 ...
1573 : !> \param nat ...
1574 : !> \param lsta ...
1575 : !> \param lstb ...
1576 : !> \param rel ...
1577 : !> \param ener ...
1578 : !> \param ener2 ...
1579 : !> \param coord ...
1580 : !> \param coord2 ...
1581 : !> \param nnbrx ...
1582 : !> \param ff ...
1583 : !> \param max_nbrs ...
1584 : !> \param istop ...
1585 : !> \param s2_t0 ...
1586 : !> \param s2_t1 ...
1587 : !> \param s2_t2 ...
1588 : !> \param s2_t3 ...
1589 : !> \param s2_dx ...
1590 : !> \param s2_dy ...
1591 : !> \param s2_dz ...
1592 : !> \param s2_r ...
1593 : !> \param num2 ...
1594 : !> \param s3_g ...
1595 : !> \param s3_dg ...
1596 : !> \param s3_rinv ...
1597 : !> \param s3_dx ...
1598 : !> \param s3_dy ...
1599 : !> \param s3_dz ...
1600 : !> \param s3_r ...
1601 : !> \param num3 ...
1602 : !> \param sz_df ...
1603 : !> \param sz_sum ...
1604 : !> \param sz_dx ...
1605 : !> \param sz_dy ...
1606 : !> \param sz_dz ...
1607 : !> \param sz_r ...
1608 : !> \param numz ...
1609 : ! **************************************************************************************************
1610 22 : SUBROUTINE subfeniat_b(iat1, iat2, nat, lsta, lstb, rel, ener, ener2, &
1611 22 : coord, coord2, nnbrx, ff, max_nbrs, istop, &
1612 22 : s2_t0, s2_t1, s2_t2, s2_t3, s2_dx, s2_dy, s2_dz, s2_r, &
1613 22 : num2, s3_g, s3_dg, s3_rinv, s3_dx, s3_dy, s3_dz, s3_r, &
1614 22 : num3, sz_df, sz_sum, sz_dx, sz_dy, sz_dz, sz_r, numz)
1615 : ! This subroutine is a modification of a subroutine that is available at
1616 : ! http://www-math.mit.edu/~bazant/EDIP/ and for which Martin Z. Bazant
1617 : ! and Harvard University have a 1997 copyright.
1618 : ! The modifications were done by S. Goedecker on April 10, 2002.
1619 : ! The routines are included with the permission of M. Bazant into this package.
1620 :
1621 : ! ------------------------- VARIABLE DECLARATIONS -------------------------
1622 : INTEGER :: iat1, iat2, nat, lsta(2, nat)
1623 : REAL(KIND=dp) :: ener, ener2, coord, coord2
1624 : INTEGER :: nnbrx
1625 : REAL(KIND=dp) :: rel(5, nnbrx*nat)
1626 : INTEGER :: lstb(nnbrx*nat)
1627 : REAL(KIND=dp) :: ff(3, nat)
1628 : INTEGER :: max_nbrs, istop
1629 : REAL(KIND=dp) :: s2_t0(max_nbrs), s2_t1(max_nbrs), s2_t2(max_nbrs), s2_t3(max_nbrs), &
1630 : s2_dx(max_nbrs), s2_dy(max_nbrs), s2_dz(max_nbrs), s2_r(max_nbrs)
1631 : INTEGER :: num2(max_nbrs)
1632 : REAL(KIND=dp) :: s3_g(max_nbrs), s3_dg(max_nbrs), s3_rinv(max_nbrs), s3_dx(max_nbrs), &
1633 : s3_dy(max_nbrs), s3_dz(max_nbrs), s3_r(max_nbrs)
1634 : INTEGER :: num3(max_nbrs)
1635 : REAL(KIND=dp) :: sz_df(max_nbrs), sz_sum(max_nbrs), &
1636 : sz_dx(max_nbrs), sz_dy(max_nbrs), &
1637 : sz_dz(max_nbrs), sz_r(max_nbrs)
1638 : INTEGER :: numz(max_nbrs)
1639 :
1640 : INTEGER :: i, j, k, l, n, n2, n3, nj, nk, nl, nz
1641 : REAL(KIND=dp) :: bmc, cmbinv, coord_iat, dEdrl, dEdrlx, dEdrly, dEdrlz, den, dhdl, dHdx, &
1642 : dp1, dtau, dV2dZ, dV2ijx, dV2ijy, dV2ijz, dV2j, dV3dZ, dV3l, dV3ljx, dV3ljy, dV3ljz, &
1643 : dV3lkx, dV3lky, dV3lkz, dV3rij, dV3rijx, dV3rijy, dV3rijz, dV3rik, dV3rikx, dV3riky, &
1644 : dV3rikz, dwinv, dx, dxdZ, dy, dz, ener_iat, fjx, fjy, fjz, fkx, fky, fkz, fZ, H, lcos, &
1645 : muhalf, par_a, par_alp, par_b, par_bet, par_bg, par_c, par_cap_A, par_cap_B, par_delta, &
1646 : par_eta, par_gam, par_lam, par_mu, par_palp, par_Qo, par_rh, par_sig, pZ, Qort, r, rinv, &
1647 : rmainv, rmbinv, tau, temp0, temp1, u1, u2, u3, u4, u5, winv, x, xarg
1648 : REAL(KIND=dp) :: xinv, xinv3, Z
1649 :
1650 : ! size of s2[]
1651 : ! atom ID numbers for s2[]
1652 : ! size of s3[]
1653 : ! atom ID numbers for s3[]
1654 : ! size of sz[]
1655 : ! atom ID numbers for sz[]
1656 : ! indices for the store arrays
1657 : ! EDIP parameters
1658 :
1659 22 : par_cap_A = 5.6714030e0_dp
1660 22 : par_cap_B = 2.0002804e0_dp
1661 22 : par_rh = 1.2085196e0_dp
1662 22 : par_a = 3.1213820e0_dp
1663 22 : par_sig = 0.5774108e0_dp
1664 22 : par_lam = 1.4533108e0_dp
1665 22 : par_gam = 1.1247945e0_dp
1666 22 : par_b = 3.1213820e0_dp
1667 22 : par_c = 2.5609104e0_dp
1668 22 : par_delta = 78.7590539e0_dp
1669 22 : par_mu = 0.6966326e0_dp
1670 22 : par_Qo = 312.1341346e0_dp
1671 22 : par_palp = 1.4074424e0_dp
1672 22 : par_bet = 0.0070975e0_dp
1673 22 : par_alp = 3.1083847e0_dp
1674 :
1675 22 : u1 = -0.165799e0_dp
1676 22 : u2 = 32.557e0_dp
1677 22 : u3 = 0.286198e0_dp
1678 22 : u4 = 0.66e0_dp
1679 :
1680 22 : par_bg = par_a
1681 22 : par_eta = par_delta/par_Qo
1682 :
1683 22022 : DO i = 1, nat
1684 22000 : ff(1, i) = 0.0e0_dp
1685 22000 : ff(2, i) = 0.0e0_dp
1686 22022 : ff(3, i) = 0.0e0_dp
1687 : END DO
1688 :
1689 22 : coord = 0.e0_dp
1690 22 : coord2 = 0.e0_dp
1691 22 : ener = 0.e0_dp
1692 22 : ener2 = 0.e0_dp
1693 22 : istop = 0
1694 :
1695 : ! COMBINE COEFFICIENTS
1696 :
1697 22 : Qort = SQRT(par_Qo)
1698 22 : muhalf = par_mu*0.5e0_dp
1699 22 : u5 = u2*u4
1700 22 : bmc = par_b - par_c
1701 22 : cmbinv = 1.0e0_dp/(par_c - par_b)
1702 :
1703 : ! --- LEVEL 1: OUTER LOOP OVER ATOMS ---
1704 :
1705 22022 : atoms: DO i = iat1, iat2
1706 :
1707 : ! RESET COORDINATION AND NEIGHBOR NUMBERS
1708 :
1709 22000 : coord_iat = 0.e0_dp
1710 22000 : ener_iat = 0.e0_dp
1711 22000 : Z = 0.0e0_dp
1712 22000 : n2 = 1
1713 22000 : n3 = 1
1714 22000 : nz = 1
1715 :
1716 : ! --- LEVEL 2: LOOP PREPASS OVER PAIRS ---
1717 :
1718 110000 : DO n = lsta(1, i), lsta(2, i)
1719 88000 : j = lstb(n)
1720 :
1721 : ! PARTS OF TWO-BODY INTERACTION r<par_a
1722 :
1723 88000 : num2(n2) = j
1724 88000 : dx = -rel(1, n)
1725 88000 : dy = -rel(2, n)
1726 88000 : dz = -rel(3, n)
1727 88000 : r = rel(4, n)
1728 88000 : rinv = rel(5, n)
1729 88000 : rmainv = 1.e0_dp/(r - par_a)
1730 88000 : s2_t0(n2) = par_cap_A*EXP(par_sig*rmainv)
1731 88000 : s2_t1(n2) = (par_cap_B*rinv)**par_rh
1732 88000 : s2_t2(n2) = par_rh*rinv
1733 88000 : s2_t3(n2) = par_sig*rmainv*rmainv
1734 88000 : s2_dx(n2) = dx
1735 88000 : s2_dy(n2) = dy
1736 88000 : s2_dz(n2) = dz
1737 88000 : s2_r(n2) = r
1738 88000 : n2 = n2 + 1
1739 88000 : IF (n2 > max_nbrs) THEN
1740 0 : WRITE (*, *) 'WARNING enlarge max_nbrs'
1741 0 : istop = 1
1742 0 : RETURN
1743 : END IF
1744 :
1745 : ! coordination number calculated with soft cutoff between first
1746 : ! nearest neighbor and midpoint of first and second nearest neighbor
1747 88000 : IF (r <= 2.36e0_dp) THEN
1748 62860 : coord_iat = coord_iat + 1.e0_dp
1749 25140 : ELSE IF (r >= 3.12e0_dp) THEN
1750 : ELSE
1751 25140 : xarg = (r - 2.36e0_dp)*(1.e0_dp/(3.12e0_dp - 2.36e0_dp))
1752 25140 : coord_iat = coord_iat + (2*xarg + 1.e0_dp)*(xarg - 1.e0_dp)**2
1753 : END IF
1754 :
1755 : ! RADIAL PARTS OF THREE-BODY INTERACTION r<par_b
1756 :
1757 47140 : IF (r < par_bg) THEN
1758 :
1759 88000 : num3(n3) = j
1760 88000 : rmbinv = 1.e0_dp/(r - par_bg)
1761 88000 : temp1 = par_gam*rmbinv
1762 88000 : temp0 = EXP(temp1)
1763 88000 : s3_g(n3) = temp0
1764 88000 : s3_dg(n3) = -rmbinv*temp1*temp0
1765 88000 : s3_dx(n3) = dx
1766 88000 : s3_dy(n3) = dy
1767 88000 : s3_dz(n3) = dz
1768 88000 : s3_rinv(n3) = rinv
1769 88000 : s3_r(n3) = r
1770 88000 : n3 = n3 + 1
1771 88000 : IF (n3 > max_nbrs) THEN
1772 0 : WRITE (*, *) 'WARNING enlarge max_nbrs'
1773 0 : istop = 1
1774 0 : RETURN
1775 : END IF
1776 :
1777 : ! COORDINATION AND NEIGHBOR FUNCTION par_c<r<par_b
1778 :
1779 88000 : IF (r < par_b) THEN
1780 88000 : IF (r < par_c) THEN
1781 88000 : Z = Z + 1.e0_dp
1782 : ELSE
1783 0 : xinv = bmc/(r - par_c)
1784 0 : xinv3 = xinv*xinv*xinv
1785 0 : den = 1.e0_dp/(1 - xinv3)
1786 0 : temp1 = par_alp*den
1787 0 : fZ = EXP(temp1)
1788 0 : Z = Z + fZ
1789 0 : numz(nz) = j
1790 0 : sz_df(nz) = fZ*temp1*den*3.e0_dp*xinv3*xinv*cmbinv
1791 : ! df/dr
1792 0 : sz_dx(nz) = dx
1793 0 : sz_dy(nz) = dy
1794 0 : sz_dz(nz) = dz
1795 0 : sz_r(nz) = r
1796 0 : nz = nz + 1
1797 0 : IF (nz > max_nbrs) THEN
1798 0 : WRITE (*, *) 'WARNING enlarge max_nbrs'
1799 0 : istop = 1
1800 0 : RETURN
1801 : END IF
1802 : END IF
1803 : ! r < par_C
1804 : END IF
1805 : ! r < par_b
1806 : END IF
1807 : ! r < par_bg
1808 : END DO
1809 :
1810 : ! ZERO ACCUMULATION ARRAY FOR ENVIRONMENT FORCES
1811 :
1812 22000 : DO nl = 1, nz - 1
1813 22000 : sz_sum(nl) = 0.e0_dp
1814 : END DO
1815 :
1816 : ! ENVIRONMENT-DEPENDENCE OF PAIR INTERACTION
1817 :
1818 22000 : temp0 = par_bet*Z
1819 22000 : pZ = par_palp*EXP(-temp0*Z)
1820 : ! bond order
1821 22000 : dp1 = -2.e0_dp*temp0*pZ
1822 : ! derivative of bond order
1823 :
1824 : ! --- LEVEL 2: LOOP FOR PAIR INTERACTIONS ---
1825 :
1826 110000 : DO nj = 1, n2 - 1
1827 :
1828 88000 : temp0 = s2_t1(nj) - pZ
1829 :
1830 : ! two-body energy V2(rij,Z)
1831 :
1832 88000 : ener_iat = ener_iat + temp0*s2_t0(nj)
1833 :
1834 : ! two-body forces
1835 :
1836 88000 : dV2j = -s2_t0(nj)*(s2_t1(nj)*s2_t2(nj) + temp0*s2_t3(nj))
1837 : ! dV2/dr
1838 88000 : dV2ijx = dV2j*s2_dx(nj)
1839 88000 : dV2ijy = dV2j*s2_dy(nj)
1840 88000 : dV2ijz = dV2j*s2_dz(nj)
1841 88000 : ff(1, i) = ff(1, i) + dV2ijx
1842 88000 : ff(2, i) = ff(2, i) + dV2ijy
1843 88000 : ff(3, i) = ff(3, i) + dV2ijz
1844 88000 : j = num2(nj)
1845 88000 : ff(1, j) = ff(1, j) - dV2ijx
1846 88000 : ff(2, j) = ff(2, j) - dV2ijy
1847 88000 : ff(3, j) = ff(3, j) - dV2ijz
1848 :
1849 : ! --- LEVEL 3: LOOP FOR PAIR COORDINATION FORCES ---
1850 :
1851 88000 : dV2dZ = -dp1*s2_t0(nj)
1852 110000 : DO nl = 1, nz - 1
1853 88000 : sz_sum(nl) = sz_sum(nl) + dV2dZ
1854 : END DO
1855 :
1856 : END DO
1857 :
1858 : ! COORDINATION-DEPENDENCE OF THREE-BODY INTERACTION
1859 :
1860 22000 : winv = Qort*EXP(-muhalf*Z)
1861 : ! inverse width of angular function
1862 22000 : dwinv = -muhalf*winv
1863 : ! its derivative
1864 22000 : temp0 = EXP(-u4*Z)
1865 22000 : tau = u1 + u2*temp0*(u3 - temp0)
1866 : ! -cosine of angular minimum
1867 22000 : dtau = u5*temp0*(2*temp0 - u3)
1868 : ! its derivative
1869 :
1870 : ! --- LEVEL 2: FIRST LOOP FOR THREE-BODY INTERACTIONS ---
1871 :
1872 88000 : DO nj = 1, n3 - 2
1873 :
1874 66000 : j = num3(nj)
1875 :
1876 : ! --- LEVEL 3: SECOND LOOP FOR THREE-BODY INTERACTIONS ---
1877 :
1878 220000 : DO nk = nj + 1, n3 - 1
1879 :
1880 132000 : k = num3(nk)
1881 :
1882 : ! angular function h(l,Z)
1883 :
1884 132000 : lcos = s3_dx(nj)*s3_dx(nk) + s3_dy(nj)*s3_dy(nk) + s3_dz(nj)*s3_dz(nk)
1885 132000 : x = (lcos + tau)*winv
1886 132000 : temp0 = EXP(-x*x)
1887 :
1888 132000 : H = par_lam*(1 - temp0 + par_eta*x*x)
1889 132000 : dHdx = 2*par_lam*x*(temp0 + par_eta)
1890 :
1891 132000 : dhdl = dHdx*winv
1892 :
1893 : ! three-body energy
1894 :
1895 132000 : temp1 = s3_g(nj)*s3_g(nk)
1896 132000 : ener_iat = ener_iat + temp1*H
1897 :
1898 : ! (-) radial force on atom j
1899 :
1900 132000 : dV3rij = s3_dg(nj)*s3_g(nk)*H
1901 132000 : dV3rijx = dV3rij*s3_dx(nj)
1902 132000 : dV3rijy = dV3rij*s3_dy(nj)
1903 132000 : dV3rijz = dV3rij*s3_dz(nj)
1904 132000 : fjx = dV3rijx
1905 132000 : fjy = dV3rijy
1906 132000 : fjz = dV3rijz
1907 :
1908 : ! (-) radial force on atom k
1909 :
1910 132000 : dV3rik = s3_g(nj)*s3_dg(nk)*H
1911 132000 : dV3rikx = dV3rik*s3_dx(nk)
1912 132000 : dV3riky = dV3rik*s3_dy(nk)
1913 132000 : dV3rikz = dV3rik*s3_dz(nk)
1914 132000 : fkx = dV3rikx
1915 132000 : fky = dV3riky
1916 132000 : fkz = dV3rikz
1917 :
1918 : ! (-) angular force on j
1919 :
1920 132000 : dV3l = temp1*dhdl
1921 132000 : dV3ljx = dV3l*(s3_dx(nk) - lcos*s3_dx(nj))*s3_rinv(nj)
1922 132000 : dV3ljy = dV3l*(s3_dy(nk) - lcos*s3_dy(nj))*s3_rinv(nj)
1923 132000 : dV3ljz = dV3l*(s3_dz(nk) - lcos*s3_dz(nj))*s3_rinv(nj)
1924 132000 : fjx = fjx + dV3ljx
1925 132000 : fjy = fjy + dV3ljy
1926 132000 : fjz = fjz + dV3ljz
1927 :
1928 : ! (-) angular force on k
1929 :
1930 132000 : dV3lkx = dV3l*(s3_dx(nj) - lcos*s3_dx(nk))*s3_rinv(nk)
1931 132000 : dV3lky = dV3l*(s3_dy(nj) - lcos*s3_dy(nk))*s3_rinv(nk)
1932 132000 : dV3lkz = dV3l*(s3_dz(nj) - lcos*s3_dz(nk))*s3_rinv(nk)
1933 132000 : fkx = fkx + dV3lkx
1934 132000 : fky = fky + dV3lky
1935 132000 : fkz = fkz + dV3lkz
1936 :
1937 : ! apply radial + angular forces to i, j, k
1938 :
1939 132000 : ff(1, j) = ff(1, j) - fjx
1940 132000 : ff(2, j) = ff(2, j) - fjy
1941 132000 : ff(3, j) = ff(3, j) - fjz
1942 132000 : ff(1, k) = ff(1, k) - fkx
1943 132000 : ff(2, k) = ff(2, k) - fky
1944 132000 : ff(3, k) = ff(3, k) - fkz
1945 132000 : ff(1, i) = ff(1, i) + fjx + fkx
1946 132000 : ff(2, i) = ff(2, i) + fjy + fky
1947 132000 : ff(3, i) = ff(3, i) + fjz + fkz
1948 :
1949 : ! prefactor for 4-body forces from coordination
1950 132000 : dxdZ = dwinv*(lcos + tau) + winv*dtau
1951 132000 : dV3dZ = temp1*dHdx*dxdZ
1952 :
1953 : ! --- LEVEL 4: LOOP FOR THREE-BODY COORDINATION FORCES ---
1954 :
1955 198000 : DO nl = 1, nz - 1
1956 132000 : sz_sum(nl) = sz_sum(nl) + dV3dZ
1957 : END DO
1958 : END DO
1959 : END DO
1960 :
1961 : ! --- LEVEL 2: LOOP TO APPLY COORDINATION FORCES ---
1962 :
1963 22000 : DO nl = 1, nz - 1
1964 :
1965 0 : dEdrl = sz_sum(nl)*sz_df(nl)
1966 0 : dEdrlx = dEdrl*sz_dx(nl)
1967 0 : dEdrly = dEdrl*sz_dy(nl)
1968 0 : dEdrlz = dEdrl*sz_dz(nl)
1969 0 : ff(1, i) = ff(1, i) + dEdrlx
1970 0 : ff(2, i) = ff(2, i) + dEdrly
1971 0 : ff(3, i) = ff(3, i) + dEdrlz
1972 0 : l = numz(nl)
1973 0 : ff(1, l) = ff(1, l) - dEdrlx
1974 0 : ff(2, l) = ff(2, l) - dEdrly
1975 22000 : ff(3, l) = ff(3, l) - dEdrlz
1976 :
1977 : END DO
1978 :
1979 22000 : coord = coord + coord_iat
1980 22000 : coord2 = coord2 + coord_iat**2
1981 22000 : ener = ener + ener_iat
1982 22022 : ener2 = ener2 + ener_iat**2
1983 :
1984 : END DO atoms
1985 :
1986 : RETURN
1987 : END SUBROUTINE subfeniat_b
1988 :
1989 : ! **************************************************************************************************
1990 : !> \brief ...
1991 : !> \param iat ...
1992 : !> \param nn ...
1993 : !> \param ncx ...
1994 : !> \param ll1 ...
1995 : !> \param ll2 ...
1996 : !> \param ll3 ...
1997 : !> \param l1 ...
1998 : !> \param l2 ...
1999 : !> \param l3 ...
2000 : !> \param myspace ...
2001 : !> \param rxyz ...
2002 : !> \param icell ...
2003 : !> \param lstb ...
2004 : !> \param lay ...
2005 : !> \param rel ...
2006 : !> \param cut2 ...
2007 : !> \param indlst ...
2008 : ! **************************************************************************************************
2009 22000 : SUBROUTINE sublstiat_b(iat, nn, ncx, ll1, ll2, ll3, l1, l2, l3, myspace, &
2010 22000 : rxyz, icell, lstb, lay, rel, cut2, indlst)
2011 : ! finds the neighbours of atom iat (specified by lsta and lstb) and and
2012 : ! the relative position rel of iat with respect to these neighbours
2013 : INTEGER :: iat, nn, ncx, ll1, ll2, ll3, l1, l2, l3, &
2014 : myspace
2015 : REAL(KIND=dp) :: rxyz(3, nn)
2016 : INTEGER :: icell(0:ncx, -1:ll1, -1:ll2, -1:ll3), lstb(0:myspace - 1), lay(nn)
2017 : REAL(KIND=dp) :: rel(5, 0:myspace - 1), cut2
2018 : INTEGER :: indlst
2019 :
2020 : INTEGER :: jat, jj, k1, k2, k3
2021 : REAL(KIND=dp) :: rr2, tt, tti, xrel, yrel, zrel
2022 :
2023 88000 : DO k3 = l3 - 1, l3 + 1
2024 286000 : DO k2 = l2 - 1, l2 + 1
2025 858000 : DO k1 = l1 - 1, l1 + 1
2026 1949124 : DO jj = 1, icell(0, k1, k2, k3)
2027 1157124 : jat = icell(jj, k1, k2, k3)
2028 1157124 : IF (jat == iat) CYCLE
2029 1135124 : xrel = rxyz(1, iat) - rxyz(1, jat)
2030 1135124 : yrel = rxyz(2, iat) - rxyz(2, jat)
2031 1135124 : zrel = rxyz(3, iat) - rxyz(3, jat)
2032 1135124 : rr2 = xrel**2 + yrel**2 + zrel**2
2033 1729124 : IF (rr2 <= cut2) THEN
2034 88000 : indlst = MIN(indlst, myspace - 1)
2035 88000 : lstb(indlst) = lay(jat)
2036 : ! write(*,*) 'iat,indlst,lay(jat)',iat,indlst,lay(jat)
2037 88000 : tt = SQRT(rr2)
2038 88000 : tti = 1.e0_dp/tt
2039 88000 : rel(1, indlst) = xrel*tti
2040 88000 : rel(2, indlst) = yrel*tti
2041 88000 : rel(3, indlst) = zrel*tti
2042 88000 : rel(4, indlst) = tt
2043 88000 : rel(5, indlst) = tti
2044 88000 : indlst = indlst + 1
2045 : END IF
2046 : END DO
2047 : END DO
2048 : END DO
2049 : END DO
2050 :
2051 22000 : RETURN
2052 : END SUBROUTINE sublstiat_b
2053 :
2054 : ! **************************************************************************************************
2055 : !> \brief Lenosky's "highly optimized empirical potential model of silicon"
2056 : !> by Stefan Goedecker
2057 : !> \param nat number of atoms
2058 : !> \param alat lattice constants of the orthorombic box containing the particles
2059 : !> \param rxyz0 atomic positions in Angstrom, may be modified on output.
2060 : !> If an atom is outside the box the program will bring it back
2061 : !> into the box by translations through alat
2062 : !> \param fxyz forces in eV/A
2063 : !> \param ener total energy in eV
2064 : !> \param coord average coordination number
2065 : !> \param ener_var variance of the energy/atom
2066 : !> \param coord_var variance of the coordination number
2067 : !> \param count count is increased by one per call, has to be initialized
2068 : !> to 0.e0_dp before first call of eip_bazant
2069 : !> \par Literature
2070 : !> T. Lenosky, et. al.: Highly optimized empirical potential model of silicon;
2071 : !> Modeling Simul. Sci. Eng., 8 (2000)
2072 : !> S. Goedecker: Optimization and parallelization of a force field for silicon
2073 : !> using OpenMP; CPC 148, 1 (2002)
2074 : !> \par History
2075 : !> 03.2006 initial create [tdk]
2076 : !> \author Thomas D. Kuehne (tkuehne@cp2k.org)
2077 : ! **************************************************************************************************
2078 22 : SUBROUTINE eip_lenosky_silicon(nat, alat, rxyz0, fxyz, ener, coord, ener_var, &
2079 : coord_var, count)
2080 :
2081 : INTEGER :: nat
2082 : REAL(KIND=dp) :: alat(3), rxyz0(3, nat), fxyz(3, nat), &
2083 : ener, coord, ener_var, coord_var, count
2084 :
2085 : INTEGER :: i, iam, iat, iat1, iat2, ii, il, in, indlst, indlstx, istop, istopg, l1, l2, l3, &
2086 : laymx, ll1, ll2, ll3, lot, myspace, myspaceout, ncx, nn, nnbrx, npjkx, npjx, npr, rlc1i, &
2087 : rlc2i, rlc3i
2088 22 : INTEGER, ALLOCATABLE, DIMENSION(:) :: lay, lstb
2089 22 : INTEGER, ALLOCATABLE, DIMENSION(:, :) :: lsta
2090 22 : INTEGER, ALLOCATABLE, DIMENSION(:, :, :, :) :: icell
2091 : REAL(KIND=dp) :: coord2, cut, cut2, ener2, tcoord, &
2092 : tcoord2, tener, tener2
2093 22 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: f2ij, f3ij, f3ik, rel, rxyz, txyz
2094 :
2095 : ! tmax_phi= 0.4500000e+01_dp
2096 : ! cut=tmax_phi
2097 22 : cut = 0.4500000e+01_dp
2098 :
2099 22 : IF (count == 0) OPEN (unit=10, file='lenosky.mon', status='unknown')
2100 22 : count = count + 1.e0_dp
2101 :
2102 : ! linear scaling calculation of verlet list
2103 22 : ll1 = INT(alat(1)/cut)
2104 22 : IF (ll1 < 1) CPABORT("alat(1) too small")
2105 22 : ll2 = INT(alat(2)/cut)
2106 22 : IF (ll2 < 1) CPABORT("alat(2) too small")
2107 22 : ll3 = INT(alat(3)/cut)
2108 22 : IF (ll3 < 1) CPABORT("alat(3) too small")
2109 :
2110 : ! determine number of threads
2111 22 : npr = 1
2112 22 : !$OMP PARALLEL PRIVATE(iam) SHARED (npr) DEFAULT(NONE)
2113 : !$ iam = omp_get_thread_num()
2114 : !$ if (iam .eq. 0) npr = omp_get_num_threads()
2115 : !$OMP END PARALLEL
2116 :
2117 : ! linear scaling calculation of verlet list
2118 :
2119 22 : IF (npr <= 1) THEN !serial if too few processors to gain by parallelizing
2120 :
2121 : ! set ncx for serial case, ncx for parallel case set below
2122 22 : ncx = 16
2123 132 : loop_ncx_s: DO
2124 924 : ALLOCATE (icell(0:ncx, -1:ll1, -1:ll2, -1:ll3))
2125 90090 : icell(0, -1:ll1, -1:ll2, -1:ll3) = 0
2126 154 : rlc1i = INT(ll1/alat(1))
2127 154 : rlc2i = INT(ll2/alat(2))
2128 154 : rlc3i = INT(ll3/alat(3))
2129 :
2130 44330 : loop_iat_s: DO iat = 1, nat
2131 44308 : rxyz0(1, iat) = MODULO(MODULO(rxyz0(1, iat), alat(1)), alat(1))
2132 44308 : rxyz0(2, iat) = MODULO(MODULO(rxyz0(2, iat), alat(2)), alat(2))
2133 44308 : rxyz0(3, iat) = MODULO(MODULO(rxyz0(3, iat), alat(3)), alat(3))
2134 44308 : l1 = INT(rxyz0(1, iat)*rlc1i)
2135 44308 : l2 = INT(rxyz0(2, iat)*rlc2i)
2136 44308 : l3 = INT(rxyz0(3, iat)*rlc3i)
2137 :
2138 44308 : ii = icell(0, l1, l2, l3)
2139 44308 : ii = ii + 1
2140 44308 : icell(0, l1, l2, l3) = ii
2141 44308 : IF (ii > ncx) THEN
2142 132 : WRITE (10, *) count, 'NCX too small', ncx
2143 132 : DEALLOCATE (icell)
2144 132 : ncx = ncx*2
2145 : CYCLE loop_ncx_s
2146 : END IF
2147 44198 : icell(ii, l1, l2, l3) = iat
2148 : END DO loop_iat_s
2149 : EXIT loop_ncx_s
2150 : END DO loop_ncx_s
2151 :
2152 : ELSE ! parallel case
2153 :
2154 : ! periodization of particles can be done in parallel
2155 0 : !$OMP PARALLEL DO SHARED (alat,nat,rxyz0) PRIVATE(iat) DEFAULT(NONE)
2156 : DO iat = 1, nat
2157 : rxyz0(1, iat) = MODULO(MODULO(rxyz0(1, iat), alat(1)), alat(1))
2158 : rxyz0(2, iat) = MODULO(MODULO(rxyz0(2, iat), alat(2)), alat(2))
2159 : rxyz0(3, iat) = MODULO(MODULO(rxyz0(3, iat), alat(3)), alat(3))
2160 : END DO
2161 : !$OMP END PARALLEL DO
2162 :
2163 : ! assignment to cell is done serially
2164 : ! set ncx for parallel case, ncx for serial case set above
2165 0 : ncx = 16
2166 0 : loop_ncx_p: DO
2167 0 : ALLOCATE (icell(0:ncx, -1:ll1, -1:ll2, -1:ll3))
2168 0 : icell(0, -1:ll1, -1:ll2, -1:ll3) = 0
2169 0 : rlc1i = INT(ll1/alat(1))
2170 0 : rlc2i = INT(ll2/alat(2))
2171 0 : rlc3i = INT(ll3/alat(3))
2172 :
2173 0 : loop_iat_p: DO iat = 1, nat
2174 0 : l1 = INT(rxyz0(1, iat)*rlc1i)
2175 0 : l2 = INT(rxyz0(2, iat)*rlc2i)
2176 0 : l3 = INT(rxyz0(3, iat)*rlc3i)
2177 0 : ii = icell(0, l1, l2, l3)
2178 0 : ii = ii + 1
2179 0 : icell(0, l1, l2, l3) = ii
2180 0 : IF (ii > ncx) THEN
2181 0 : WRITE (10, *) count, 'NCX too small', ncx
2182 0 : DEALLOCATE (icell)
2183 0 : ncx = ncx*2
2184 : CYCLE loop_ncx_p
2185 : END IF
2186 0 : icell(ii, l1, l2, l3) = iat
2187 : END DO loop_iat_p
2188 : EXIT loop_ncx_p
2189 : END DO loop_ncx_p
2190 :
2191 : END IF
2192 :
2193 : ! duplicate all atoms within boundary layer
2194 22 : laymx = ncx*(2*ll1*ll2 + 2*ll1*ll3 + 2*ll2*ll3 + 4*ll1 + 4*ll2 + 4*ll3 + 8)
2195 22 : nn = nat + laymx
2196 110 : ALLOCATE (rxyz(3, nn), lay(nn))
2197 22022 : DO iat = 1, nat
2198 22000 : lay(iat) = iat
2199 22000 : rxyz(1, iat) = rxyz0(1, iat)
2200 22000 : rxyz(2, iat) = rxyz0(2, iat)
2201 22022 : rxyz(3, iat) = rxyz0(3, iat)
2202 : END DO
2203 22 : il = nat
2204 : ! xy plane
2205 154 : DO l2 = 0, ll2 - 1
2206 946 : DO l1 = 0, ll1 - 1
2207 :
2208 792 : in = icell(0, l1, l2, 0)
2209 792 : icell(0, l1, l2, ll3) = in
2210 22792 : DO ii = 1, in
2211 22000 : i = icell(ii, l1, l2, 0)
2212 22000 : il = il + 1
2213 22000 : IF (il > nn) CPABORT("enlarge laymx")
2214 22000 : lay(il) = i
2215 22000 : icell(ii, l1, l2, ll3) = il
2216 22000 : rxyz(1, il) = rxyz(1, i)
2217 22000 : rxyz(2, il) = rxyz(2, i)
2218 22792 : rxyz(3, il) = rxyz(3, i) + alat(3)
2219 : END DO
2220 :
2221 792 : in = icell(0, l1, l2, ll3 - 1)
2222 792 : icell(0, l1, l2, -1) = in
2223 924 : DO ii = 1, in
2224 0 : i = icell(ii, l1, l2, ll3 - 1)
2225 0 : il = il + 1
2226 0 : IF (il > nn) CPABORT("enlarge laymx")
2227 0 : lay(il) = i
2228 0 : icell(ii, l1, l2, -1) = il
2229 0 : rxyz(1, il) = rxyz(1, i)
2230 0 : rxyz(2, il) = rxyz(2, i)
2231 792 : rxyz(3, il) = rxyz(3, i) - alat(3)
2232 : END DO
2233 :
2234 : END DO
2235 : END DO
2236 :
2237 : ! yz plane
2238 154 : DO l3 = 0, ll3 - 1
2239 946 : DO l2 = 0, ll2 - 1
2240 :
2241 792 : in = icell(0, 0, l2, l3)
2242 792 : icell(0, ll1, l2, l3) = in
2243 22792 : DO ii = 1, in
2244 22000 : i = icell(ii, 0, l2, l3)
2245 22000 : il = il + 1
2246 22000 : IF (il > nn) CPABORT("enlarge laymx")
2247 22000 : lay(il) = i
2248 22000 : icell(ii, ll1, l2, l3) = il
2249 22000 : rxyz(1, il) = rxyz(1, i) + alat(1)
2250 22000 : rxyz(2, il) = rxyz(2, i)
2251 22792 : rxyz(3, il) = rxyz(3, i)
2252 : END DO
2253 :
2254 792 : in = icell(0, ll1 - 1, l2, l3)
2255 792 : icell(0, -1, l2, l3) = in
2256 924 : DO ii = 1, in
2257 0 : i = icell(ii, ll1 - 1, l2, l3)
2258 0 : il = il + 1
2259 0 : IF (il > nn) CPABORT("enlarge laymx")
2260 0 : lay(il) = i
2261 0 : icell(ii, -1, l2, l3) = il
2262 0 : rxyz(1, il) = rxyz(1, i) - alat(1)
2263 0 : rxyz(2, il) = rxyz(2, i)
2264 792 : rxyz(3, il) = rxyz(3, i)
2265 : END DO
2266 :
2267 : END DO
2268 : END DO
2269 :
2270 : ! xz plane
2271 154 : DO l3 = 0, ll3 - 1
2272 946 : DO l1 = 0, ll1 - 1
2273 :
2274 792 : in = icell(0, l1, 0, l3)
2275 792 : icell(0, l1, ll2, l3) = in
2276 22792 : DO ii = 1, in
2277 22000 : i = icell(ii, l1, 0, l3)
2278 22000 : il = il + 1
2279 22000 : IF (il > nn) CPABORT("enlarge laymx")
2280 22000 : lay(il) = i
2281 22000 : icell(ii, l1, ll2, l3) = il
2282 22000 : rxyz(1, il) = rxyz(1, i)
2283 22000 : rxyz(2, il) = rxyz(2, i) + alat(2)
2284 22792 : rxyz(3, il) = rxyz(3, i)
2285 : END DO
2286 :
2287 792 : in = icell(0, l1, ll2 - 1, l3)
2288 792 : icell(0, l1, -1, l3) = in
2289 924 : DO ii = 1, in
2290 0 : i = icell(ii, l1, ll2 - 1, l3)
2291 0 : il = il + 1
2292 0 : IF (il > nn) CPABORT("enlarge laymx")
2293 0 : lay(il) = i
2294 0 : icell(ii, l1, -1, l3) = il
2295 0 : rxyz(1, il) = rxyz(1, i)
2296 0 : rxyz(2, il) = rxyz(2, i) - alat(2)
2297 792 : rxyz(3, il) = rxyz(3, i)
2298 : END DO
2299 :
2300 : END DO
2301 : END DO
2302 :
2303 : ! x axis
2304 154 : DO l1 = 0, ll1 - 1
2305 :
2306 132 : in = icell(0, l1, 0, 0)
2307 132 : icell(0, l1, ll2, ll3) = in
2308 22132 : DO ii = 1, in
2309 22000 : i = icell(ii, l1, 0, 0)
2310 22000 : il = il + 1
2311 22000 : IF (il > nn) CPABORT("enlarge laymx")
2312 22000 : lay(il) = i
2313 22000 : icell(ii, l1, ll2, ll3) = il
2314 22000 : rxyz(1, il) = rxyz(1, i)
2315 22000 : rxyz(2, il) = rxyz(2, i) + alat(2)
2316 22132 : rxyz(3, il) = rxyz(3, i) + alat(3)
2317 : END DO
2318 :
2319 132 : in = icell(0, l1, 0, ll3 - 1)
2320 132 : icell(0, l1, ll2, -1) = in
2321 132 : DO ii = 1, in
2322 0 : i = icell(ii, l1, 0, ll3 - 1)
2323 0 : il = il + 1
2324 0 : IF (il > nn) CPABORT("enlarge laymx")
2325 0 : lay(il) = i
2326 0 : icell(ii, l1, ll2, -1) = il
2327 0 : rxyz(1, il) = rxyz(1, i)
2328 0 : rxyz(2, il) = rxyz(2, i) + alat(2)
2329 132 : rxyz(3, il) = rxyz(3, i) - alat(3)
2330 : END DO
2331 :
2332 132 : in = icell(0, l1, ll2 - 1, 0)
2333 132 : icell(0, l1, -1, ll3) = in
2334 132 : DO ii = 1, in
2335 0 : i = icell(ii, l1, ll2 - 1, 0)
2336 0 : il = il + 1
2337 0 : IF (il > nn) CPABORT("enlarge laymx")
2338 0 : lay(il) = i
2339 0 : icell(ii, l1, -1, ll3) = il
2340 0 : rxyz(1, il) = rxyz(1, i)
2341 0 : rxyz(2, il) = rxyz(2, i) - alat(2)
2342 132 : rxyz(3, il) = rxyz(3, i) + alat(3)
2343 : END DO
2344 :
2345 132 : in = icell(0, l1, ll2 - 1, ll3 - 1)
2346 132 : icell(0, l1, -1, -1) = in
2347 154 : DO ii = 1, in
2348 0 : i = icell(ii, l1, ll2 - 1, ll3 - 1)
2349 0 : il = il + 1
2350 0 : IF (il > nn) CPABORT("enlarge laymx")
2351 0 : lay(il) = i
2352 0 : icell(ii, l1, -1, -1) = il
2353 0 : rxyz(1, il) = rxyz(1, i)
2354 0 : rxyz(2, il) = rxyz(2, i) - alat(2)
2355 132 : rxyz(3, il) = rxyz(3, i) - alat(3)
2356 : END DO
2357 :
2358 : END DO
2359 :
2360 : ! y axis
2361 154 : DO l2 = 0, ll2 - 1
2362 :
2363 132 : in = icell(0, 0, l2, 0)
2364 132 : icell(0, ll1, l2, ll3) = in
2365 22132 : DO ii = 1, in
2366 22000 : i = icell(ii, 0, l2, 0)
2367 22000 : il = il + 1
2368 22000 : IF (il > nn) CPABORT("enlarge laymx")
2369 22000 : lay(il) = i
2370 22000 : icell(ii, ll1, l2, ll3) = il
2371 22000 : rxyz(1, il) = rxyz(1, i) + alat(1)
2372 22000 : rxyz(2, il) = rxyz(2, i)
2373 22132 : rxyz(3, il) = rxyz(3, i) + alat(3)
2374 : END DO
2375 :
2376 132 : in = icell(0, 0, l2, ll3 - 1)
2377 132 : icell(0, ll1, l2, -1) = in
2378 132 : DO ii = 1, in
2379 0 : i = icell(ii, 0, l2, ll3 - 1)
2380 0 : il = il + 1
2381 0 : IF (il > nn) CPABORT("enlarge laymx")
2382 0 : lay(il) = i
2383 0 : icell(ii, ll1, l2, -1) = il
2384 0 : rxyz(1, il) = rxyz(1, i) + alat(1)
2385 0 : rxyz(2, il) = rxyz(2, i)
2386 132 : rxyz(3, il) = rxyz(3, i) - alat(3)
2387 : END DO
2388 :
2389 132 : in = icell(0, ll1 - 1, l2, 0)
2390 132 : icell(0, -1, l2, ll3) = in
2391 132 : DO ii = 1, in
2392 0 : i = icell(ii, ll1 - 1, l2, 0)
2393 0 : il = il + 1
2394 0 : IF (il > nn) CPABORT("enlarge laymx")
2395 0 : lay(il) = i
2396 0 : icell(ii, -1, l2, ll3) = il
2397 0 : rxyz(1, il) = rxyz(1, i) - alat(1)
2398 0 : rxyz(2, il) = rxyz(2, i)
2399 132 : rxyz(3, il) = rxyz(3, i) + alat(3)
2400 : END DO
2401 :
2402 132 : in = icell(0, ll1 - 1, l2, ll3 - 1)
2403 132 : icell(0, -1, l2, -1) = in
2404 154 : DO ii = 1, in
2405 0 : i = icell(ii, ll1 - 1, l2, ll3 - 1)
2406 0 : il = il + 1
2407 0 : IF (il > nn) CPABORT("enlarge laymx")
2408 0 : lay(il) = i
2409 0 : icell(ii, -1, l2, -1) = il
2410 0 : rxyz(1, il) = rxyz(1, i) - alat(1)
2411 0 : rxyz(2, il) = rxyz(2, i)
2412 132 : rxyz(3, il) = rxyz(3, i) - alat(3)
2413 : END DO
2414 :
2415 : END DO
2416 :
2417 : ! z axis
2418 154 : DO l3 = 0, ll3 - 1
2419 :
2420 132 : in = icell(0, 0, 0, l3)
2421 132 : icell(0, ll1, ll2, l3) = in
2422 22132 : DO ii = 1, in
2423 22000 : i = icell(ii, 0, 0, l3)
2424 22000 : il = il + 1
2425 22000 : IF (il > nn) CPABORT("enlarge laymx")
2426 22000 : lay(il) = i
2427 22000 : icell(ii, ll1, ll2, l3) = il
2428 22000 : rxyz(1, il) = rxyz(1, i) + alat(1)
2429 22000 : rxyz(2, il) = rxyz(2, i) + alat(2)
2430 22132 : rxyz(3, il) = rxyz(3, i)
2431 : END DO
2432 :
2433 132 : in = icell(0, ll1 - 1, 0, l3)
2434 132 : icell(0, -1, ll2, l3) = in
2435 132 : DO ii = 1, in
2436 0 : i = icell(ii, ll1 - 1, 0, l3)
2437 0 : il = il + 1
2438 0 : IF (il > nn) CPABORT("enlarge laymx")
2439 0 : lay(il) = i
2440 0 : icell(ii, -1, ll2, l3) = il
2441 0 : rxyz(1, il) = rxyz(1, i) - alat(1)
2442 0 : rxyz(2, il) = rxyz(2, i) + alat(2)
2443 132 : rxyz(3, il) = rxyz(3, i)
2444 : END DO
2445 :
2446 132 : in = icell(0, 0, ll2 - 1, l3)
2447 132 : icell(0, ll1, -1, l3) = in
2448 132 : DO ii = 1, in
2449 0 : i = icell(ii, 0, ll2 - 1, l3)
2450 0 : il = il + 1
2451 0 : IF (il > nn) CPABORT("enlarge laymx")
2452 0 : lay(il) = i
2453 0 : icell(ii, ll1, -1, l3) = il
2454 0 : rxyz(1, il) = rxyz(1, i) + alat(1)
2455 0 : rxyz(2, il) = rxyz(2, i) - alat(2)
2456 132 : rxyz(3, il) = rxyz(3, i)
2457 : END DO
2458 :
2459 132 : in = icell(0, ll1 - 1, ll2 - 1, l3)
2460 132 : icell(0, -1, -1, l3) = in
2461 154 : DO ii = 1, in
2462 0 : i = icell(ii, ll1 - 1, ll2 - 1, l3)
2463 0 : il = il + 1
2464 0 : IF (il > nn) CPABORT("enlarge laymx")
2465 0 : lay(il) = i
2466 0 : icell(ii, -1, -1, l3) = il
2467 0 : rxyz(1, il) = rxyz(1, i) - alat(1)
2468 0 : rxyz(2, il) = rxyz(2, i) - alat(2)
2469 132 : rxyz(3, il) = rxyz(3, i)
2470 : END DO
2471 :
2472 : END DO
2473 :
2474 : ! corners
2475 22 : in = icell(0, 0, 0, 0)
2476 22 : icell(0, ll1, ll2, ll3) = in
2477 22022 : DO ii = 1, in
2478 22000 : i = icell(ii, 0, 0, 0)
2479 22000 : il = il + 1
2480 22000 : IF (il > nn) CPABORT("enlarge laymx")
2481 22000 : lay(il) = i
2482 22000 : icell(ii, ll1, ll2, ll3) = il
2483 22000 : rxyz(1, il) = rxyz(1, i) + alat(1)
2484 22000 : rxyz(2, il) = rxyz(2, i) + alat(2)
2485 22022 : rxyz(3, il) = rxyz(3, i) + alat(3)
2486 : END DO
2487 :
2488 22 : in = icell(0, ll1 - 1, 0, 0)
2489 22 : icell(0, -1, ll2, ll3) = in
2490 22 : DO ii = 1, in
2491 0 : i = icell(ii, ll1 - 1, 0, 0)
2492 0 : il = il + 1
2493 0 : IF (il > nn) CPABORT("enlarge laymx")
2494 0 : lay(il) = i
2495 0 : icell(ii, -1, ll2, ll3) = il
2496 0 : rxyz(1, il) = rxyz(1, i) - alat(1)
2497 0 : rxyz(2, il) = rxyz(2, i) + alat(2)
2498 22 : rxyz(3, il) = rxyz(3, i) + alat(3)
2499 : END DO
2500 :
2501 22 : in = icell(0, 0, ll2 - 1, 0)
2502 22 : icell(0, ll1, -1, ll3) = in
2503 22 : DO ii = 1, in
2504 0 : i = icell(ii, 0, ll2 - 1, 0)
2505 0 : il = il + 1
2506 0 : IF (il > nn) CPABORT("enlarge laymx")
2507 0 : lay(il) = i
2508 0 : icell(ii, ll1, -1, ll3) = il
2509 0 : rxyz(1, il) = rxyz(1, i) + alat(1)
2510 0 : rxyz(2, il) = rxyz(2, i) - alat(2)
2511 22 : rxyz(3, il) = rxyz(3, i) + alat(3)
2512 : END DO
2513 :
2514 22 : in = icell(0, ll1 - 1, ll2 - 1, 0)
2515 22 : icell(0, -1, -1, ll3) = in
2516 22 : DO ii = 1, in
2517 0 : i = icell(ii, ll1 - 1, ll2 - 1, 0)
2518 0 : il = il + 1
2519 0 : IF (il > nn) CPABORT("enlarge laymx")
2520 0 : lay(il) = i
2521 0 : icell(ii, -1, -1, ll3) = il
2522 0 : rxyz(1, il) = rxyz(1, i) - alat(1)
2523 0 : rxyz(2, il) = rxyz(2, i) - alat(2)
2524 22 : rxyz(3, il) = rxyz(3, i) + alat(3)
2525 : END DO
2526 :
2527 22 : in = icell(0, 0, 0, ll3 - 1)
2528 22 : icell(0, ll1, ll2, -1) = in
2529 22 : DO ii = 1, in
2530 0 : i = icell(ii, 0, 0, ll3 - 1)
2531 0 : il = il + 1
2532 0 : IF (il > nn) CPABORT("enlarge laymx")
2533 0 : lay(il) = i
2534 0 : icell(ii, ll1, ll2, -1) = il
2535 0 : rxyz(1, il) = rxyz(1, i) + alat(1)
2536 0 : rxyz(2, il) = rxyz(2, i) + alat(2)
2537 22 : rxyz(3, il) = rxyz(3, i) - alat(3)
2538 : END DO
2539 :
2540 22 : in = icell(0, ll1 - 1, 0, ll3 - 1)
2541 22 : icell(0, -1, ll2, -1) = in
2542 22 : DO ii = 1, in
2543 0 : i = icell(ii, ll1 - 1, 0, ll3 - 1)
2544 0 : il = il + 1
2545 0 : IF (il > nn) CPABORT("enlarge laymx")
2546 0 : lay(il) = i
2547 0 : icell(ii, -1, ll2, -1) = il
2548 0 : rxyz(1, il) = rxyz(1, i) - alat(1)
2549 0 : rxyz(2, il) = rxyz(2, i) + alat(2)
2550 22 : rxyz(3, il) = rxyz(3, i) - alat(3)
2551 : END DO
2552 :
2553 22 : in = icell(0, 0, ll2 - 1, ll3 - 1)
2554 22 : icell(0, ll1, -1, -1) = in
2555 22 : DO ii = 1, in
2556 0 : i = icell(ii, 0, ll2 - 1, ll3 - 1)
2557 0 : il = il + 1
2558 0 : IF (il > nn) CPABORT("enlarge laymx")
2559 0 : lay(il) = i
2560 0 : icell(ii, ll1, -1, -1) = il
2561 0 : rxyz(1, il) = rxyz(1, i) + alat(1)
2562 0 : rxyz(2, il) = rxyz(2, i) - alat(2)
2563 22 : rxyz(3, il) = rxyz(3, i) - alat(3)
2564 : END DO
2565 :
2566 22 : in = icell(0, ll1 - 1, ll2 - 1, ll3 - 1)
2567 22 : icell(0, -1, -1, -1) = in
2568 22 : DO ii = 1, in
2569 0 : i = icell(ii, ll1 - 1, ll2 - 1, ll3 - 1)
2570 0 : il = il + 1
2571 0 : IF (il > nn) CPABORT("enlarge laymx")
2572 0 : lay(il) = i
2573 0 : icell(ii, -1, -1, -1) = il
2574 0 : rxyz(1, il) = rxyz(1, i) - alat(1)
2575 0 : rxyz(2, il) = rxyz(2, i) - alat(2)
2576 22 : rxyz(3, il) = rxyz(3, i) - alat(3)
2577 : END DO
2578 :
2579 66 : ALLOCATE (lsta(2, nat))
2580 22 : nnbrx = 36
2581 0 : loop_nnbrx: DO
2582 110 : ALLOCATE (lstb(nnbrx*nat), rel(5, nnbrx*nat))
2583 :
2584 22 : indlstx = 0
2585 :
2586 : !$OMP PARALLEL DEFAULT(NONE) &
2587 : !$OMP PRIVATE(iat,cut2,iam,ii,indlst,l1,l2,l3,myspace,npr) &
2588 : !$OMP SHARED (indlstx,nat,nn,nnbrx,ncx,ll1,ll2,ll3,icell,lsta,lstb,lay, &
2589 22 : !$OMP rel,rxyz,cut,myspaceout)
2590 :
2591 : npr = 1
2592 : !$ npr = omp_get_num_threads()
2593 : iam = 0
2594 : !$ iam = omp_get_thread_num()
2595 :
2596 : cut2 = cut**2
2597 : ! assign contiguous portions of the arrays lstb and rel to the threads
2598 : myspace = (nat*nnbrx)/npr
2599 : IF (iam == 0) myspaceout = myspace
2600 : ! Verlet list, relative positions
2601 : indlst = 0
2602 : loop_l3: DO l3 = 0, ll3 - 1
2603 : loop_l2: DO l2 = 0, ll2 - 1
2604 : loop_l1: DO l1 = 0, ll1 - 1
2605 : loop_ii: DO ii = 1, icell(0, l1, l2, l3)
2606 : iat = icell(ii, l1, l2, l3)
2607 : IF (((iat - 1)*npr)/nat == iam) THEN
2608 : ! write(*,*) 'sublstiat:iam,iat',iam,iat
2609 : lsta(1, iat) = iam*myspace + indlst + 1
2610 : CALL sublstiat_l(iat, nn, ncx, ll1, ll2, ll3, l1, l2, l3, myspace, &
2611 : rxyz, icell, lstb(iam*myspace + 1), lay, &
2612 : rel(1, iam*myspace + 1), cut2, indlst)
2613 : lsta(2, iat) = iam*myspace + indlst
2614 : ! write(*,'(a,4(x,i3),100(x,i2))') &
2615 : ! 'iam,iat,lsta',iam,iat,lsta(1,iat),lsta(2,iat), &
2616 : ! (lstb(j),j=lsta(1,iat),lsta(2,iat))
2617 : END IF
2618 : END DO loop_ii
2619 : END DO loop_l1
2620 : END DO loop_l2
2621 : END DO loop_l3
2622 :
2623 : !$OMP ATOMIC UPDATE
2624 : indlstx = MAX(indlstx, indlst)
2625 : !$OMP END ATOMIC
2626 : !$OMP END PARALLEL
2627 :
2628 22 : IF (indlstx >= myspaceout) THEN
2629 0 : WRITE (10, *) count, 'NNBRX too small', nnbrx
2630 0 : DEALLOCATE (lstb, rel)
2631 0 : nnbrx = 3*nnbrx/2
2632 : CYCLE loop_nnbrx
2633 : END IF
2634 : EXIT loop_nnbrx
2635 : END DO loop_nnbrx
2636 :
2637 22 : istopg = 0
2638 : !$OMP PARALLEL DEFAULT(NONE) &
2639 : !$OMP PRIVATE(iam,npr,iat,iat1,iat2,lot,istop,tcoord,tcoord2, &
2640 : !$OMP tener,tener2,txyz,f2ij,f3ij,f3ik,npjx,npjkx) &
2641 22 : !$OMP SHARED (nat,nnbrx,lsta,lstb,rel,ener,ener2,fxyz,coord,coord2,istopg)
2642 :
2643 : npr = 1
2644 : !$ npr = omp_get_num_threads()
2645 : iam = 0
2646 : !$ iam = omp_get_thread_num()
2647 :
2648 : npjx = 300; npjkx = 6000
2649 :
2650 : IF (npr /= 1) THEN
2651 : ! PARALLEL CASE
2652 : ! create temporary private scalars for reduction sum on energies and
2653 : ! temporary private array for reduction sum on forces
2654 : !$OMP CRITICAL(omp_eip_lenosky_silicon)
2655 : ALLOCATE (txyz(3, nat), f2ij(3, npjx), f3ij(3, npjkx), f3ik(3, npjkx))
2656 : !$OMP END CRITICAL(omp_eip_lenosky_silicon)
2657 : IF (iam == 0) THEN
2658 : ener = 0.e0_dp
2659 : ener2 = 0.e0_dp
2660 : coord = 0.e0_dp
2661 : coord2 = 0.e0_dp
2662 : END IF
2663 : !$OMP DO
2664 : DO iat = 1, nat
2665 : fxyz(1, iat) = 0.e0_dp
2666 : fxyz(2, iat) = 0.e0_dp
2667 : fxyz(3, iat) = 0.e0_dp
2668 : END DO
2669 : !$OMP BARRIER
2670 :
2671 : ! Each thread treats at most lot atoms
2672 : lot = INT(REAL(nat, KIND=dp)/REAL(npr, KIND=dp) + .999999999999e0_dp)
2673 : iat1 = iam*lot + 1
2674 : iat2 = MIN((iam + 1)*lot, nat)
2675 : ! write(*,*) 'subfeniat:iat1,iat2,iam',iat1,iat2,iam
2676 : CALL subfeniat_l(iat1, iat2, nat, lsta, lstb, rel, tener, tener2, &
2677 : tcoord, tcoord2, nnbrx, txyz, f2ij, npjx, f3ij, npjkx, f3ik, istop)
2678 : !$OMP CRITICAL(omp_eip_lenosky_silicon)
2679 : ener = ener + tener
2680 : ener2 = ener2 + tener2
2681 : coord = coord + tcoord
2682 : coord2 = coord2 + tcoord2
2683 : istopg = istopg + istop
2684 : DO iat = 1, nat
2685 : fxyz(1, iat) = fxyz(1, iat) + txyz(1, iat)
2686 : fxyz(2, iat) = fxyz(2, iat) + txyz(2, iat)
2687 : fxyz(3, iat) = fxyz(3, iat) + txyz(3, iat)
2688 : END DO
2689 : DEALLOCATE (txyz, f2ij, f3ij, f3ik)
2690 : !$OMP END CRITICAL(omp_eip_lenosky_silicon)
2691 :
2692 : ELSE
2693 : ! SERIAL CASE
2694 : iat1 = 1
2695 : iat2 = nat
2696 : ALLOCATE (f2ij(3, npjx), f3ij(3, npjkx), f3ik(3, npjkx))
2697 : CALL subfeniat_l(iat1, iat2, nat, lsta, lstb, rel, ener, ener2, &
2698 : coord, coord2, nnbrx, fxyz, f2ij, npjx, f3ij, npjkx, f3ik, istopg)
2699 : DEALLOCATE (f2ij, f3ij, f3ik)
2700 :
2701 : END IF
2702 : !$OMP END PARALLEL
2703 :
2704 22 : IF (istopg > 0) CPABORT("DIMENSION ERROR (see WARNING above)")
2705 22 : ener_var = ener2/nat - (ener/nat)**2
2706 22 : coord = coord/nat
2707 22 : coord_var = coord2/nat - coord**2
2708 :
2709 22 : DEALLOCATE (rxyz, icell, lay, lsta, lstb, rel)
2710 :
2711 22 : END SUBROUTINE eip_lenosky_silicon
2712 :
2713 : ! **************************************************************************************************
2714 : !> \brief ...
2715 : !> \param iat1 ...
2716 : !> \param iat2 ...
2717 : !> \param nat ...
2718 : !> \param lsta ...
2719 : !> \param lstb ...
2720 : !> \param rel ...
2721 : !> \param tener ...
2722 : !> \param tener2 ...
2723 : !> \param tcoord ...
2724 : !> \param tcoord2 ...
2725 : !> \param nnbrx ...
2726 : !> \param txyz ...
2727 : !> \param f2ij ...
2728 : !> \param npjx ...
2729 : !> \param f3ij ...
2730 : !> \param npjkx ...
2731 : !> \param f3ik ...
2732 : !> \param istop ...
2733 : ! **************************************************************************************************
2734 22 : SUBROUTINE subfeniat_l(iat1, iat2, nat, lsta, lstb, rel, tener, tener2, &
2735 22 : tcoord, tcoord2, nnbrx, txyz, f2ij, npjx, f3ij, npjkx, f3ik, istop)
2736 : ! for a subset of atoms iat1 to iat2 the routine calculates the (partial) forces
2737 : ! txyz acting on these atoms as well as on the atoms (jat, kat) interacting
2738 : ! with them and their contribution to the energy (tener).
2739 : ! In addition the coordination number tcoord and the second moment of the
2740 : ! local energy tener2 and coordination number tcoord2 are returned
2741 : INTEGER :: iat1, iat2, nat, lsta(2, nat)
2742 : REAL(KIND=dp) :: tener, tener2, tcoord, tcoord2
2743 : INTEGER :: nnbrx
2744 : REAL(KIND=dp) :: rel(5, nnbrx*nat)
2745 : INTEGER :: lstb(nnbrx*nat)
2746 : REAL(KIND=dp) :: txyz(3, nat)
2747 : INTEGER :: npjx
2748 : REAL(KIND=dp) :: f2ij(3, npjx)
2749 : INTEGER :: npjkx
2750 : REAL(KIND=dp) :: f3ij(3, npjkx), f3ik(3, npjkx)
2751 : INTEGER :: istop
2752 :
2753 : REAL(KIND=dp), DIMENSION(0:10), PARAMETER :: cof_rho = [0.13747000000000e+00_dp, &
2754 : -0.14831000000000e+00_dp, -0.55972000000000e+00_dp, -0.73110000000000e+00_dp, &
2755 : -0.76283000000000e+00_dp, -0.72918000000000e+00_dp, -0.66620000000000e+00_dp, &
2756 : -0.57328000000000e+00_dp, -0.40690000000000e+00_dp, -0.16662000000000e+00_dp, &
2757 : 0.00000000000000e+00_dp]
2758 : REAL(KIND=dp), DIMENSION(0:10), PARAMETER :: dof_rho = [-0.32275496741918e+01_dp, &
2759 : -0.64119006516165e+01_dp, 0.10030652280658e+02_dp, 0.22937915289857e+01_dp, &
2760 : 0.17416816033995e+01_dp, 0.54648205741626e+00_dp, 0.47189016693543e+00_dp, &
2761 : 0.20569572748420e+01_dp, 0.23192807336964e+01_dp, -0.24908020962757e+00_dp, &
2762 : -0.12371959895186e+02_dp]
2763 : REAL(KIND=dp), DIMENSION(0:7), PARAMETER :: cof_ggg = [0.52541600000000e+01_dp, &
2764 : 0.23591500000000e+01_dp, 0.11959500000000e+01_dp, 0.12299500000000e+01_dp, &
2765 : 0.20356500000000e+01_dp, 0.34247400000000e+01_dp, 0.49485900000000e+01_dp, &
2766 : 0.56179900000000e+01_dp], cof_uuu = [-0.10749300000000e+01_dp, -0.20045000000000e+00_dp, &
2767 : 0.41422000000000e+00_dp, 0.87939000000000e+00_dp, 0.12668900000000e+01_dp, &
2768 : 0.16299800000000e+01_dp, 0.19773800000000e+01_dp, 0.23961800000000e+01_dp]
2769 : REAL(KIND=dp), DIMENSION(0:7), PARAMETER :: dof_ggg = [0.15826876132396e+02_dp, &
2770 : 0.31176239377907e+02_dp, 0.16589446539683e+02_dp, 0.11083892500520e+02_dp, &
2771 : 0.90887216383860e+01_dp, 0.54902279653967e+01_dp, -0.18823313223755e+02_dp, &
2772 : -0.77183416481005e+01_dp], dof_uuu = [-0.14827125747284e+00_dp, -0.14922155328475e+00_dp, &
2773 : -0.70113224223509e-01_dp, -0.39449020349230e-01_dp, -0.15815242579643e-01_dp, &
2774 : 0.26112640061855e-01_dp, -0.13786974745095e+00_dp, 0.74941595372657e+00_dp]
2775 : REAL(KIND=dp), DIMENSION(0:9), PARAMETER :: cof_fff = [0.12503100000000e+01_dp, &
2776 : 0.86821000000000e+00_dp, 0.60846000000000e+00_dp, 0.48756000000000e+00_dp, &
2777 : 0.44163000000000e+00_dp, 0.37610000000000e+00_dp, 0.27145000000000e+00_dp, &
2778 : 0.14814000000000e+00_dp, 0.48550000000000e-01_dp, 0.00000000000000e+00_dp], cof_phi = [ &
2779 : 0.69299400000000e+01_dp, -0.43995000000000e+00_dp, -0.17012300000000e+01_dp, &
2780 : -0.16247300000000e+01_dp, -0.99696000000000e+00_dp, -0.27391000000000e+00_dp, &
2781 : -0.24990000000000e-01_dp, -0.17840000000000e-01_dp, -0.96100000000000e-02_dp, &
2782 : 0.00000000000000e+00_dp]
2783 : REAL(KIND=dp), DIMENSION(0:9), PARAMETER :: dof_fff = [0.27904652711432e+02_dp, &
2784 : -0.45230754228635e+01_dp, 0.50531739800222e+01_dp, 0.11806545027747e+01_dp, &
2785 : -0.66693699112098e+00_dp, -0.89430653829079e+00_dp, -0.50891685571587e+00_dp, &
2786 : 0.66278396115427e+00_dp, 0.73976101109878e+00_dp, 0.25795319944506e+01_dp], dof_phi = [ &
2787 : 0.16533229480429e+03_dp, 0.39415410391417e+02_dp, 0.68710036300407e+01_dp, &
2788 : 0.53406950884203e+01_dp, 0.15347960162782e+01_dp, -0.63347591535331e+01_dp, &
2789 : -0.17987794021458e+01_dp, 0.47429676211617e+00_dp, -0.40087646318907e-01_dp, &
2790 : -0.23942617684055e+00_dp]
2791 : REAL(KIND=dp), PARAMETER :: h2sixth_fff = 8.23045267489712e-003_dp, &
2792 : h2sixth_ggg = 1.10221225156463e-002_dp, h2sixth_phi = 1.85185185185185e-002_dp, &
2793 : h2sixth_rho = 6.66666666666667e-003_dp, h2sixth_uuu = 0.318679429600340e0_dp, &
2794 : hi_fff = 4.50000000000e0_dp, hi_ggg = 3.88858644327663e0_dp, hi_phi = 3.00000000000e0_dp, &
2795 : hi_rho = 5.00000000000e0_dp, hi_uuu = 0.723181585730594e0_dp, &
2796 : hsixth_fff = 3.70370370370370e-002_dp, hsixth_ggg = 4.28604761904762e-002_dp, &
2797 : hsixth_phi = 5.55555555555556e-002_dp, hsixth_rho = 3.33333333333333e-002_dp, &
2798 : hsixth_uuu = 0.230463095238095e0_dp
2799 : REAL(KIND=dp), PARAMETER :: tmax_fff = 0.3500000e+01_dp, tmax_ggg = 0.8001400e+00_dp, &
2800 : tmax_phi = 0.4500000e+01_dp, tmax_rho = 0.3500000e+01_dp, tmax_uuu = 0.7908520e+01_dp, &
2801 : tmin_fff = 0.1500000e+01_dp, tmin_ggg = -0.1000000e+01_dp, tmin_phi = 0.1500000e+01_dp, &
2802 : tmin_rho = 0.1500000e+01_dp, tmin_uuu = -0.1770930e+01_dp
2803 :
2804 : INTEGER :: iat, jat, jbr, jcnt, jkcnt, kat, kbr, &
2805 : khi_fff, khi_ggg, klo_fff, klo_ggg
2806 : REAL(KIND=dp) :: a2_fff, a2_ggg, a_fff, a_ggg, b2_fff, b2_ggg, b_fff, b_ggg, cof1_fff, &
2807 : cof1_ggg, cof2_fff, cof2_ggg, cof3_fff, cof3_ggg, cof4_fff, cof4_ggg, cof_fff_khi, &
2808 : cof_fff_klo, cof_ggg_khi, cof_ggg_klo, coord_iat, costheta, dens, dens2, dens3, &
2809 : dof_fff_khi, dof_fff_klo, dof_ggg_khi, dof_ggg_klo, e_phi, e_uuu, ener_iat, ep_phi, &
2810 : ep_uuu, fij, fijp, fik, fikp, fxij, fxik, fyij, fyik, fzij, fzik, gjik, gjikp, rho, rhop, &
2811 : rij, rik, sij, sik, t1, t2, t3, t4, tt, tt_fff, tt_ggg, xarg, ypt1_fff, ypt1_ggg, &
2812 : ypt2_fff, ypt2_ggg, yt1_fff, yt1_ggg, yt2_fff, yt2_ggg
2813 :
2814 : ! initialize temporary private scalars for reduction sum on energies and
2815 : ! private workarray txyz for forces forces
2816 22 : tener = 0.e0_dp
2817 22 : tener2 = 0.e0_dp
2818 22 : tcoord = 0.e0_dp
2819 22 : tcoord2 = 0.e0_dp
2820 22 : istop = 0
2821 22022 : DO iat = 1, nat
2822 22000 : txyz(1, iat) = 0.e0_dp
2823 22000 : txyz(2, iat) = 0.e0_dp
2824 22022 : txyz(3, iat) = 0.e0_dp
2825 : END DO
2826 :
2827 : ! calculation of forces, energy
2828 :
2829 22022 : forces_and_energy: DO iat = iat1, iat2
2830 :
2831 22000 : dens2 = 0.e0_dp
2832 22000 : dens3 = 0.e0_dp
2833 22000 : jcnt = 0
2834 22000 : jkcnt = 0
2835 22000 : coord_iat = 0.e0_dp
2836 22000 : ener_iat = 0.e0_dp
2837 203528 : calculate: DO jbr = lsta(1, iat), lsta(2, iat)
2838 181528 : jat = lstb(jbr)
2839 181528 : jcnt = jcnt + 1
2840 181528 : IF (jcnt > npjx) THEN
2841 0 : WRITE (*, *) 'WARNING: enlarge npjx'
2842 0 : istop = 1
2843 0 : RETURN
2844 : END IF
2845 :
2846 181528 : fxij = rel(1, jbr)
2847 181528 : fyij = rel(2, jbr)
2848 181528 : fzij = rel(3, jbr)
2849 181528 : rij = rel(4, jbr)
2850 181528 : sij = rel(5, jbr)
2851 :
2852 : ! coordination number calculated with soft cutoff between first
2853 : ! nearest neighbor and midpoint of first and second nearest neighbor
2854 181528 : IF (rij <= 2.36e0_dp) THEN
2855 27688 : coord_iat = coord_iat + 1.e0_dp
2856 153840 : ELSE IF (rij >= 3.12e0_dp) THEN
2857 : ELSE
2858 10042 : xarg = (rij - 2.36e0_dp)*(1.e0_dp/(3.12e0_dp - 2.36e0_dp))
2859 10042 : coord_iat = coord_iat + (2*xarg + 1.e0_dp)*(xarg - 1.e0_dp)**2
2860 : END IF
2861 :
2862 : ! pairpotential term
2863 : CALL splint(cof_phi, dof_phi, tmin_phi, tmax_phi, &
2864 181528 : hsixth_phi, h2sixth_phi, hi_phi, 10, rij, e_phi, ep_phi)
2865 181528 : ener_iat = ener_iat + (e_phi*.5e0_dp)
2866 181528 : txyz(1, iat) = txyz(1, iat) - fxij*(ep_phi*.5e0_dp)
2867 181528 : txyz(2, iat) = txyz(2, iat) - fyij*(ep_phi*.5e0_dp)
2868 181528 : txyz(3, iat) = txyz(3, iat) - fzij*(ep_phi*.5e0_dp)
2869 181528 : txyz(1, jat) = txyz(1, jat) + fxij*(ep_phi*.5e0_dp)
2870 181528 : txyz(2, jat) = txyz(2, jat) + fyij*(ep_phi*.5e0_dp)
2871 181528 : txyz(3, jat) = txyz(3, jat) + fzij*(ep_phi*.5e0_dp)
2872 :
2873 : ! 2 body embedding term
2874 : CALL splint(cof_rho, dof_rho, tmin_rho, tmax_rho, &
2875 181528 : hsixth_rho, h2sixth_rho, hi_rho, 11, rij, rho, rhop)
2876 181528 : dens2 = dens2 + rho
2877 181528 : f2ij(1, jcnt) = fxij*rhop
2878 181528 : f2ij(2, jcnt) = fyij*rhop
2879 181528 : f2ij(3, jcnt) = fzij*rhop
2880 :
2881 : ! 3 body embedding term
2882 : CALL splint(cof_fff, dof_fff, tmin_fff, tmax_fff, &
2883 181528 : hsixth_fff, h2sixth_fff, hi_fff, 10, rij, fij, fijp)
2884 :
2885 2098776 : embed_3body: DO kbr = lsta(1, iat), lsta(2, iat)
2886 1895248 : kat = lstb(kbr)
2887 2076776 : IF (kat < jat) THEN
2888 856860 : jkcnt = jkcnt + 1
2889 856860 : IF (jkcnt > npjkx) THEN
2890 0 : WRITE (*, *) 'WARNING: enlarge npjkx', npjkx
2891 0 : istop = 1
2892 0 : RETURN
2893 : END IF
2894 :
2895 : ! begin unoptimized original version:
2896 : ! fxik=rel(1,kbr)
2897 : ! fyik=rel(2,kbr)
2898 : ! fzik=rel(3,kbr)
2899 : ! rik=rel(4,kbr)
2900 : ! sik=rel(5,kbr)
2901 : !
2902 : ! call splint(cof_fff,dof_fff,tmin_fff,tmax_fff, &
2903 : ! hsixth_fff,h2sixth_fff,hi_fff,10,rik,fik,fikp)
2904 : ! costheta=fxij*fxik+fyij*fyik+fzij*fzik
2905 : ! call splint(cof_ggg,dof_ggg,tmin_ggg,tmax_ggg, &
2906 : ! hsixth_ggg,h2sixth_ggg,hi_ggg,8,costheta,gjik,gjikp)
2907 : ! end unoptimized original version:
2908 :
2909 : ! begin optimized version
2910 856860 : rik = rel(4, kbr)
2911 856860 : IF (rik > tmax_fff) THEN
2912 : fikp = 0.e0_dp; fik = 0.e0_dp
2913 : gjik = 0.e0_dp; gjikp = 0.e0_dp; sik = 0.e0_dp
2914 : costheta = 0.e0_dp; fxik = 0.e0_dp; fyik = 0.e0_dp; fzik = 0.e0_dp
2915 141598 : ELSE IF (rik < tmin_fff) THEN
2916 0 : fxik = rel(1, kbr)
2917 0 : fyik = rel(2, kbr)
2918 0 : fzik = rel(3, kbr)
2919 0 : costheta = fxij*fxik + fyij*fyik + fzij*fzik
2920 0 : sik = rel(5, kbr)
2921 : fikp = hi_fff*(cof_fff(1) - cof_fff(0)) - &
2922 0 : (dof_fff(1) + 2.e0_dp*dof_fff(0))*hsixth_fff
2923 0 : fik = cof_fff(0) + (rik - tmin_fff)*fikp
2924 0 : tt_ggg = (costheta - tmin_ggg)*hi_ggg
2925 0 : IF (costheta > tmax_ggg) THEN
2926 : gjikp = hi_ggg*(cof_ggg(8 - 1) - cof_ggg(8 - 2)) + &
2927 0 : (2.e0_dp*dof_ggg(8 - 1) + dof_ggg(8 - 2))*hsixth_ggg
2928 0 : gjik = cof_ggg(8 - 1) + (costheta - tmax_ggg)*gjikp
2929 : ELSE
2930 0 : klo_ggg = INT(tt_ggg)
2931 0 : khi_ggg = klo_ggg + 1
2932 0 : cof_ggg_klo = cof_ggg(klo_ggg)
2933 0 : dof_ggg_klo = dof_ggg(klo_ggg)
2934 0 : b_ggg = tt_ggg - klo_ggg
2935 0 : a_ggg = 1.e0_dp - b_ggg
2936 0 : cof_ggg_khi = cof_ggg(khi_ggg)
2937 0 : dof_ggg_khi = dof_ggg(khi_ggg)
2938 0 : b2_ggg = b_ggg*b_ggg
2939 0 : gjik = a_ggg*cof_ggg_klo
2940 0 : gjikp = cof_ggg_khi - cof_ggg_klo
2941 0 : a2_ggg = a_ggg*a_ggg
2942 0 : cof1_ggg = a2_ggg - 1.e0_dp
2943 0 : cof2_ggg = b2_ggg - 1.e0_dp
2944 0 : gjik = gjik + b_ggg*cof_ggg_khi
2945 0 : gjikp = hi_ggg*gjikp
2946 0 : cof3_ggg = 3.e0_dp*b2_ggg
2947 0 : cof4_ggg = 3.e0_dp*a2_ggg
2948 0 : cof1_ggg = a_ggg*cof1_ggg
2949 0 : cof2_ggg = b_ggg*cof2_ggg
2950 0 : cof3_ggg = cof3_ggg - 1.e0_dp
2951 0 : cof4_ggg = cof4_ggg - 1.e0_dp
2952 0 : yt1_ggg = cof1_ggg*dof_ggg_klo
2953 0 : yt2_ggg = cof2_ggg*dof_ggg_khi
2954 0 : ypt1_ggg = cof3_ggg*dof_ggg_khi
2955 0 : ypt2_ggg = cof4_ggg*dof_ggg_klo
2956 0 : gjik = gjik + (yt1_ggg + yt2_ggg)*h2sixth_ggg
2957 0 : gjikp = gjikp + (ypt1_ggg - ypt2_ggg)*hsixth_ggg
2958 : END IF
2959 : ELSE
2960 141598 : fxik = rel(1, kbr)
2961 141598 : tt_fff = rik - tmin_fff
2962 141598 : costheta = fxij*fxik
2963 141598 : fyik = rel(2, kbr)
2964 141598 : tt_fff = tt_fff*hi_fff
2965 141598 : costheta = costheta + fyij*fyik
2966 141598 : fzik = rel(3, kbr)
2967 141598 : klo_fff = INT(tt_fff)
2968 141598 : costheta = costheta + fzij*fzik
2969 141598 : sik = rel(5, kbr)
2970 141598 : tt_ggg = (costheta - tmin_ggg)*hi_ggg
2971 141598 : IF (costheta > tmax_ggg) THEN
2972 : gjikp = hi_ggg*(cof_ggg(8 - 1) - cof_ggg(8 - 2)) + &
2973 23640 : (2.e0_dp*dof_ggg(8 - 1) + dof_ggg(8 - 2))*hsixth_ggg
2974 23640 : gjik = cof_ggg(8 - 1) + (costheta - tmax_ggg)*gjikp
2975 23640 : khi_fff = klo_fff + 1
2976 23640 : cof_fff_klo = cof_fff(klo_fff)
2977 23640 : dof_fff_klo = dof_fff(klo_fff)
2978 23640 : b_fff = tt_fff - klo_fff
2979 23640 : a_fff = 1.e0_dp - b_fff
2980 23640 : cof_fff_khi = cof_fff(khi_fff)
2981 23640 : dof_fff_khi = dof_fff(khi_fff)
2982 23640 : b2_fff = b_fff*b_fff
2983 23640 : fik = a_fff*cof_fff_klo
2984 23640 : fikp = cof_fff_khi - cof_fff_klo
2985 23640 : a2_fff = a_fff*a_fff
2986 23640 : cof1_fff = a2_fff - 1.e0_dp
2987 23640 : cof2_fff = b2_fff - 1.e0_dp
2988 23640 : fik = fik + b_fff*cof_fff_khi
2989 23640 : fikp = hi_fff*fikp
2990 23640 : cof3_fff = 3.e0_dp*b2_fff
2991 23640 : cof4_fff = 3.e0_dp*a2_fff
2992 23640 : cof1_fff = a_fff*cof1_fff
2993 23640 : cof2_fff = b_fff*cof2_fff
2994 23640 : cof3_fff = cof3_fff - 1.e0_dp
2995 23640 : cof4_fff = cof4_fff - 1.e0_dp
2996 23640 : yt1_fff = cof1_fff*dof_fff_klo
2997 23640 : yt2_fff = cof2_fff*dof_fff_khi
2998 23640 : ypt1_fff = cof3_fff*dof_fff_khi
2999 23640 : ypt2_fff = cof4_fff*dof_fff_klo
3000 23640 : fik = fik + (yt1_fff + yt2_fff)*h2sixth_fff
3001 23640 : fikp = fikp + (ypt1_fff - ypt2_fff)*hsixth_fff
3002 : ELSE
3003 117958 : klo_ggg = INT(tt_ggg)
3004 117958 : khi_ggg = klo_ggg + 1
3005 117958 : khi_fff = klo_fff + 1
3006 117958 : cof_ggg_klo = cof_ggg(klo_ggg)
3007 117958 : cof_fff_klo = cof_fff(klo_fff)
3008 117958 : dof_ggg_klo = dof_ggg(klo_ggg)
3009 117958 : dof_fff_klo = dof_fff(klo_fff)
3010 117958 : b_ggg = tt_ggg - klo_ggg
3011 117958 : b_fff = tt_fff - klo_fff
3012 117958 : a_ggg = 1.e0_dp - b_ggg
3013 117958 : a_fff = 1.e0_dp - b_fff
3014 117958 : cof_ggg_khi = cof_ggg(khi_ggg)
3015 117958 : cof_fff_khi = cof_fff(khi_fff)
3016 117958 : dof_ggg_khi = dof_ggg(khi_ggg)
3017 117958 : dof_fff_khi = dof_fff(khi_fff)
3018 117958 : b2_ggg = b_ggg*b_ggg
3019 117958 : b2_fff = b_fff*b_fff
3020 117958 : gjik = a_ggg*cof_ggg_klo
3021 117958 : fik = a_fff*cof_fff_klo
3022 117958 : gjikp = cof_ggg_khi - cof_ggg_klo
3023 117958 : fikp = cof_fff_khi - cof_fff_klo
3024 117958 : a2_ggg = a_ggg*a_ggg
3025 117958 : a2_fff = a_fff*a_fff
3026 117958 : cof1_ggg = a2_ggg - 1.e0_dp
3027 117958 : cof1_fff = a2_fff - 1.e0_dp
3028 117958 : cof2_ggg = b2_ggg - 1.e0_dp
3029 117958 : cof2_fff = b2_fff - 1.e0_dp
3030 117958 : gjik = gjik + b_ggg*cof_ggg_khi
3031 117958 : fik = fik + b_fff*cof_fff_khi
3032 117958 : gjikp = hi_ggg*gjikp
3033 117958 : fikp = hi_fff*fikp
3034 117958 : cof3_ggg = 3.e0_dp*b2_ggg
3035 117958 : cof3_fff = 3.e0_dp*b2_fff
3036 117958 : cof4_ggg = 3.e0_dp*a2_ggg
3037 117958 : cof4_fff = 3.e0_dp*a2_fff
3038 117958 : cof1_ggg = a_ggg*cof1_ggg
3039 117958 : cof1_fff = a_fff*cof1_fff
3040 117958 : cof2_ggg = b_ggg*cof2_ggg
3041 117958 : cof2_fff = b_fff*cof2_fff
3042 117958 : cof3_ggg = cof3_ggg - 1.e0_dp
3043 117958 : cof3_fff = cof3_fff - 1.e0_dp
3044 117958 : cof4_ggg = cof4_ggg - 1.e0_dp
3045 117958 : cof4_fff = cof4_fff - 1.e0_dp
3046 117958 : yt1_ggg = cof1_ggg*dof_ggg_klo
3047 117958 : yt1_fff = cof1_fff*dof_fff_klo
3048 117958 : yt2_ggg = cof2_ggg*dof_ggg_khi
3049 117958 : yt2_fff = cof2_fff*dof_fff_khi
3050 117958 : ypt1_ggg = cof3_ggg*dof_ggg_khi
3051 117958 : ypt1_fff = cof3_fff*dof_fff_khi
3052 117958 : ypt2_ggg = cof4_ggg*dof_ggg_klo
3053 117958 : ypt2_fff = cof4_fff*dof_fff_klo
3054 117958 : gjik = gjik + (yt1_ggg + yt2_ggg)*h2sixth_ggg
3055 117958 : fik = fik + (yt1_fff + yt2_fff)*h2sixth_fff
3056 117958 : gjikp = gjikp + (ypt1_ggg - ypt2_ggg)*hsixth_ggg
3057 117958 : fikp = fikp + (ypt1_fff - ypt2_fff)*hsixth_fff
3058 : END IF
3059 : END IF
3060 : ! end optimized version
3061 :
3062 856860 : tt = fij*fik
3063 856860 : dens3 = dens3 + tt*gjik
3064 :
3065 856860 : t1 = fijp*fik*gjik
3066 856860 : t2 = sij*(tt*gjikp)
3067 856860 : f3ij(1, jkcnt) = fxij*t1 + (fxik - fxij*costheta)*t2
3068 856860 : f3ij(2, jkcnt) = fyij*t1 + (fyik - fyij*costheta)*t2
3069 856860 : f3ij(3, jkcnt) = fzij*t1 + (fzik - fzij*costheta)*t2
3070 :
3071 856860 : t3 = fikp*fij*gjik
3072 856860 : t4 = sik*(tt*gjikp)
3073 856860 : f3ik(1, jkcnt) = fxik*t3 + (fxij - fxik*costheta)*t4
3074 856860 : f3ik(2, jkcnt) = fyik*t3 + (fyij - fyik*costheta)*t4
3075 856860 : f3ik(3, jkcnt) = fzik*t3 + (fzij - fzik*costheta)*t4
3076 : END IF
3077 :
3078 : END DO embed_3body
3079 : END DO calculate
3080 :
3081 22000 : dens = dens2 + dens3
3082 : CALL splint(cof_uuu, dof_uuu, tmin_uuu, tmax_uuu, &
3083 22000 : hsixth_uuu, h2sixth_uuu, hi_uuu, 8, dens, e_uuu, ep_uuu)
3084 22000 : ener_iat = ener_iat + e_uuu
3085 :
3086 : ! Only now ep_uu is known and the forces can be calculated, lets loop again
3087 22000 : jcnt = 0
3088 22000 : jkcnt = 0
3089 203528 : loop_again: DO jbr = lsta(1, iat), lsta(2, iat)
3090 181528 : jat = lstb(jbr)
3091 181528 : jcnt = jcnt + 1
3092 181528 : txyz(1, iat) = txyz(1, iat) - ep_uuu*f2ij(1, jcnt)
3093 181528 : txyz(2, iat) = txyz(2, iat) - ep_uuu*f2ij(2, jcnt)
3094 181528 : txyz(3, iat) = txyz(3, iat) - ep_uuu*f2ij(3, jcnt)
3095 181528 : txyz(1, jat) = txyz(1, jat) + ep_uuu*f2ij(1, jcnt)
3096 181528 : txyz(2, jat) = txyz(2, jat) + ep_uuu*f2ij(2, jcnt)
3097 181528 : txyz(3, jat) = txyz(3, jat) + ep_uuu*f2ij(3, jcnt)
3098 :
3099 : ! 3 body embedding term
3100 2098776 : DO kbr = lsta(1, iat), lsta(2, iat)
3101 1895248 : kat = lstb(kbr)
3102 2076776 : IF (kat < jat) THEN
3103 856860 : jkcnt = jkcnt + 1
3104 :
3105 856860 : txyz(1, iat) = txyz(1, iat) - ep_uuu*(f3ij(1, jkcnt) + f3ik(1, jkcnt))
3106 856860 : txyz(2, iat) = txyz(2, iat) - ep_uuu*(f3ij(2, jkcnt) + f3ik(2, jkcnt))
3107 856860 : txyz(3, iat) = txyz(3, iat) - ep_uuu*(f3ij(3, jkcnt) + f3ik(3, jkcnt))
3108 856860 : txyz(1, jat) = txyz(1, jat) + ep_uuu*f3ij(1, jkcnt)
3109 856860 : txyz(2, jat) = txyz(2, jat) + ep_uuu*f3ij(2, jkcnt)
3110 856860 : txyz(3, jat) = txyz(3, jat) + ep_uuu*f3ij(3, jkcnt)
3111 856860 : txyz(1, kat) = txyz(1, kat) + ep_uuu*f3ik(1, jkcnt)
3112 856860 : txyz(2, kat) = txyz(2, kat) + ep_uuu*f3ik(2, jkcnt)
3113 856860 : txyz(3, kat) = txyz(3, kat) + ep_uuu*f3ik(3, jkcnt)
3114 : END IF
3115 : END DO
3116 :
3117 : END DO loop_again
3118 :
3119 : ! write(*,'(a,i4,x,e19.12,x,e10.3)') 'iat,ener_iat,coord_iat', &
3120 : ! iat,ener_iat,coord_iat
3121 22000 : tener = tener + ener_iat
3122 22000 : tener2 = tener2 + ener_iat**2
3123 22000 : tcoord = tcoord + coord_iat
3124 22022 : tcoord2 = tcoord2 + coord_iat**2
3125 :
3126 : END DO forces_and_energy
3127 :
3128 : END SUBROUTINE subfeniat_l
3129 :
3130 : ! **************************************************************************************************
3131 : !> \brief ...
3132 : !> \param iat ...
3133 : !> \param nn ...
3134 : !> \param ncx ...
3135 : !> \param ll1 ...
3136 : !> \param ll2 ...
3137 : !> \param ll3 ...
3138 : !> \param l1 ...
3139 : !> \param l2 ...
3140 : !> \param l3 ...
3141 : !> \param myspace ...
3142 : !> \param rxyz ...
3143 : !> \param icell ...
3144 : !> \param lstb ...
3145 : !> \param lay ...
3146 : !> \param rel ...
3147 : !> \param cut2 ...
3148 : !> \param indlst ...
3149 : ! **************************************************************************************************
3150 22000 : SUBROUTINE sublstiat_l(iat, nn, ncx, ll1, ll2, ll3, l1, l2, l3, myspace, &
3151 22000 : rxyz, icell, lstb, lay, rel, cut2, indlst)
3152 : ! finds the neighbours of atom iat (specified by lsta and lstb) and and
3153 : ! the relative position rel of iat with respect to these neighbours
3154 : INTEGER :: iat, nn, ncx, ll1, ll2, ll3, l1, l2, l3, &
3155 : myspace
3156 : REAL(KIND=dp) :: rxyz(3, nn)
3157 : INTEGER :: icell(0:ncx, -1:ll1, -1:ll2, -1:ll3), lstb(0:myspace - 1), lay(nn)
3158 : REAL(KIND=dp) :: rel(5, 0:myspace - 1), cut2
3159 : INTEGER :: indlst
3160 :
3161 : INTEGER :: jat, jj, k1, k2, k3
3162 : REAL(KIND=dp) :: rr2, tt, tti, xrel, yrel, zrel
3163 :
3164 88000 : loop_k3: DO k3 = l3 - 1, l3 + 1
3165 242000 : loop_k2: DO k2 = l2 - 1, l2 + 1
3166 726000 : loop_k1: DO k1 = l1 - 1, l1 + 1
3167 11649000 : loop_jj: DO jj = 1, icell(0, k1, k2, k3)
3168 11011000 : jat = icell(jj, k1, k2, k3)
3169 11011000 : IF (jat == iat) CYCLE loop_k3
3170 10989000 : xrel = rxyz(1, iat) - rxyz(1, jat)
3171 10989000 : yrel = rxyz(2, iat) - rxyz(2, jat)
3172 10989000 : zrel = rxyz(3, iat) - rxyz(3, jat)
3173 10989000 : rr2 = xrel**2 + yrel**2 + zrel**2
3174 11473000 : IF (rr2 <= cut2) THEN
3175 181528 : indlst = MIN(indlst, myspace - 1)
3176 181528 : lstb(indlst) = lay(jat)
3177 : ! write(*,*) 'iat,indlst,lay(jat)',iat,indlst,lay(jat)
3178 181528 : tt = SQRT(rr2)
3179 181528 : tti = 1.e0_dp/tt
3180 181528 : rel(1, indlst) = xrel*tti
3181 181528 : rel(2, indlst) = yrel*tti
3182 181528 : rel(3, indlst) = zrel*tti
3183 181528 : rel(4, indlst) = tt
3184 181528 : rel(5, indlst) = tti
3185 181528 : indlst = indlst + 1
3186 : END IF
3187 : END DO loop_jj
3188 : END DO loop_k1
3189 : END DO loop_k2
3190 : END DO loop_k3
3191 :
3192 22000 : RETURN
3193 : END SUBROUTINE sublstiat_l
3194 :
3195 : ! **************************************************************************************************
3196 : !> \brief ...
3197 : !> \param ya ...
3198 : !> \param y2a ...
3199 : !> \param tmin ...
3200 : !> \param tmax ...
3201 : !> \param hsixth ...
3202 : !> \param h2sixth ...
3203 : !> \param hi ...
3204 : !> \param n ...
3205 : !> \param x ...
3206 : !> \param y ...
3207 : !> \param yp ...
3208 : ! **************************************************************************************************
3209 566584 : SUBROUTINE splint(ya, y2a, tmin, tmax, hsixth, h2sixth, hi, n, x, y, yp)
3210 : REAL(KIND=dp) :: tmin, tmax, hsixth, h2sixth, hi
3211 : INTEGER :: n
3212 : REAL(KIND=dp) :: y2a(0:n - 1), ya(0:n - 1), x, y, yp
3213 :
3214 : INTEGER :: khi, klo
3215 : REAL(KIND=dp) :: a, a2, b, b2, cof1, cof2, cof3, cof4, &
3216 : tt, y2a_khi, y2a_klo, ya_khi, ya_klo, &
3217 : ypt1, ypt2, yt1, yt2
3218 :
3219 : ! interpolate if the argument is outside the cubic spline interval [tmin,tmax]
3220 566584 : tt = (x - tmin)*hi
3221 566584 : IF (x < tmin) THEN
3222 : yp = hi*(ya(1) - ya(0)) - &
3223 0 : (y2a(1) + 2.e0_dp*y2a(0))*hsixth
3224 0 : y = ya(0) + (x - tmin)*yp
3225 566584 : ELSE IF (x > tmax) THEN
3226 : yp = hi*(ya(n - 1) - ya(n - 2)) + &
3227 287596 : (2.e0_dp*y2a(n - 1) + y2a(n - 2))*hsixth
3228 287596 : y = ya(n - 1) + (x - tmax)*yp
3229 : ! otherwise evaluate cubic spline
3230 : ELSE
3231 278988 : klo = INT(tt)
3232 278988 : khi = klo + 1
3233 278988 : ya_klo = ya(klo)
3234 278988 : y2a_klo = y2a(klo)
3235 278988 : b = tt - klo
3236 278988 : a = 1.e0_dp - b
3237 278988 : ya_khi = ya(khi)
3238 278988 : y2a_khi = y2a(khi)
3239 278988 : b2 = b*b
3240 278988 : y = a*ya_klo
3241 278988 : yp = ya_khi - ya_klo
3242 278988 : a2 = a*a
3243 278988 : cof1 = a2 - 1.e0_dp
3244 278988 : cof2 = b2 - 1.e0_dp
3245 278988 : y = y + b*ya_khi
3246 278988 : yp = hi*yp
3247 278988 : cof3 = 3.e0_dp*b2
3248 278988 : cof4 = 3.e0_dp*a2
3249 278988 : cof1 = a*cof1
3250 278988 : cof2 = b*cof2
3251 278988 : cof3 = cof3 - 1.e0_dp
3252 278988 : cof4 = cof4 - 1.e0_dp
3253 278988 : yt1 = cof1*y2a_klo
3254 278988 : yt2 = cof2*y2a_khi
3255 278988 : ypt1 = cof3*y2a_khi
3256 278988 : ypt2 = cof4*y2a_klo
3257 278988 : y = y + (yt1 + yt2)*h2sixth
3258 278988 : yp = yp + (ypt1 - ypt2)*hsixth
3259 : END IF
3260 566584 : RETURN
3261 : END SUBROUTINE splint
3262 :
3263 : ! **************************************************************************************************
3264 : ! Additional EIP kernels consolidated here to match the original Bazant/Lenosky layout.
3265 : ! **************************************************************************************************
3266 :
3267 : ! **************************************************************************************************
3268 : !> \brief ...
3269 : !> \param nat ...
3270 : !> \param alat ...
3271 : !> \param rxyz0 ...
3272 : !> \param fxyz ...
3273 : !> \param etot ...
3274 : !> \param count ...
3275 : ! **************************************************************************************************
3276 22 : SUBROUTINE eip_stillinger_weber_silicon(nat, alat, rxyz0, fxyz, etot, count)
3277 : !*****************************************************************************************
3278 : ! This subroutine evaluates the Stillinger Weber Silicon potential with linear scaling
3279 : ! COPYRIGHT
3280 : ! Copyright (C) 2009 AIST, UNIBAS
3281 : ! This file is distributed under the terms of the
3282 : ! GNU General Public License, see
3283 : ! http://www.gnu.org/copyleft/gpl.txt .
3284 : !
3285 : ! Implementation: Original version was written by Tetsuya Morishita, AIST Tsukuba (JP)
3286 : ! Improved by M. Amsler, S. Goedecker, Basel University (CH), 2009
3287 : !
3288 : ! Note:
3289 : !
3290 : ! aa is the parameter A given on page 5263 of PRB 31, 5262 (1985).
3291 : ! bb is the parameter B given on page 5263 of PRB 31, 5262 (1985).
3292 : ! ra is the parameter a given on page 5263 of PRB 31, 5262 (1985).
3293 : ! gam and ramda are the parameters gamma and lambda
3294 : ! for the 3-body term, respectively (see Eq. (2.5) in the paper).
3295 : !
3296 : ! Input:
3297 : ! nat, integer: the number of atoms
3298 : ! alat, REAL(KIND=dp), dim(3) : the three edges of the orthoromic simulation cell, periodic boundaries are applied
3299 : ! and atoms outside the cell will be brought back into the box
3300 : ! rxyz, REAL(KIND=dp), dim(3,nat) : the xyz cartesian components of the atomic positions in Angstroem
3301 : !
3302 : ! Output:
3303 : ! fxyz, REAL(KIND=dp), dim(3,nat): the xyz cartesian forces in on the corresponding atomic components n eV/A
3304 : ! etot, REAL(KIND=dp) : total potential energy, 2-body and 3-body, in eV
3305 : ! count, REAL(KIND=dp) : increased by 1._dp at each call of this subroutine,
3306 : ! needs to be initialized to 0._dp before calling this routine for the first time
3307 : !
3308 : ! Other variables:
3309 : ! p: the 2-body potential energy
3310 : ! p3: the 3-body potential energy
3311 : ! fx(i) , fy(i) , fz(i) are the 2-body forces on atom i.
3312 : ! fx3(i), fy3(i), fz3(i) are the 3-body forces on atom i.
3313 : ! fxyz(3,nat) contains both 2-body and 3-body forces
3314 : !
3315 : ! All units follow the description in PRB 31, 5262 (1985).
3316 : !*****************************************************************************************
3317 :
3318 : INTEGER :: nat
3319 : REAL(dp) :: alat(3), rxyz0(3, nat), fxyz(3, nat), &
3320 : etot, count
3321 :
3322 : REAL(KIND=dp), PARAMETER :: eps = 2.167239428587_dp, ra = 1.8_dp, &
3323 : sigma = 2.0951_dp
3324 :
3325 : INTEGER :: i, iam, iat, ii, il, in, indlst, &
3326 : indlstx, ipb, l1, l2, l3, laymx, ll1, &
3327 : ll2, ll3, myspace, myspaceout, ncx, &
3328 : ndat, nn, nnbrx, npjkx, npjx, npr
3329 22 : INTEGER, ALLOCATABLE, DIMENSION(:) :: lay, lstb
3330 22 : INTEGER, ALLOCATABLE, DIMENSION(:, :) :: lsta
3331 22 : INTEGER, ALLOCATABLE, DIMENSION(:, :, :, :) :: icell
3332 44 : REAL(dp) :: cut, cut2, esigma, fx(nat), fx3(nat), &
3333 44 : fy(nat), fy3(nat), fz(nat), fz3(nat), &
3334 : isigma, p, p3, pv3, rlc1i, rlc2i, rlc3i
3335 22 : REAL(dp), ALLOCATABLE, DIMENSION(:, :) :: rel, rxyz
3336 :
3337 22 : count = count + 1._dp
3338 22 : cut = sigma*ra*2._dp
3339 22 : isigma = 1._dp/sigma
3340 22 : esigma = eps*isigma
3341 :
3342 : ! linear scaling calculation of verlet list, only serial
3343 22 : ll1 = INT(alat(1)/cut)
3344 22 : IF (ll1 < 1) CPABORT("alat(1) too small")
3345 22 : ll2 = INT(alat(2)/cut)
3346 22 : IF (ll2 < 1) CPABORT("alat(2) too small")
3347 22 : ll3 = INT(alat(3)/cut)
3348 22 : IF (ll3 < 1) CPABORT("alat(3) too small")
3349 :
3350 22 : npr = 1
3351 22 : ncx = 29
3352 : DO
3353 22 : ncx = ncx*2
3354 132 : ALLOCATE (icell(0:ncx, -1:ll1, -1:ll2, -1:ll3))
3355 3432 : icell(0, :, :, :) = 0
3356 22 : rlc1i = ll1/alat(1)
3357 22 : rlc2i = ll2/alat(2)
3358 22 : rlc3i = ll3/alat(3)
3359 :
3360 22022 : DO iat = 1, nat
3361 22000 : rxyz0(1, iat) = MODULO(MODULO(rxyz0(1, iat), alat(1)), alat(1))
3362 22000 : rxyz0(2, iat) = MODULO(MODULO(rxyz0(2, iat), alat(2)), alat(2))
3363 22000 : rxyz0(3, iat) = MODULO(MODULO(rxyz0(3, iat), alat(3)), alat(3))
3364 22000 : l1 = INT(rxyz0(1, iat)*rlc1i)
3365 22000 : l2 = INT(rxyz0(2, iat)*rlc2i)
3366 22000 : l3 = INT(rxyz0(3, iat)*rlc3i)
3367 :
3368 22000 : ii = icell(0, l1, l2, l3)
3369 22000 : ii = ii + 1
3370 22000 : icell(0, l1, l2, l3) = ii
3371 22000 : IF (ii > ncx) THEN
3372 0 : DEALLOCATE (icell)
3373 0 : EXIT
3374 : END IF
3375 22022 : icell(ii, l1, l2, l3) = iat
3376 : END DO
3377 22 : IF (ALLOCATED(icell)) EXIT
3378 : END DO
3379 :
3380 : ! duplicate all atoms within boundary layer
3381 22 : laymx = ncx*(2*ll1*ll2 + 2*ll1*ll3 + 2*ll2*ll3 + 4*ll1 + 4*ll2 + 4*ll3 + 8)
3382 22 : nn = nat + laymx
3383 110 : ALLOCATE (rxyz(3, nn), lay(nn))
3384 22022 : DO iat = 1, nat
3385 22000 : lay(iat) = iat
3386 22000 : rxyz(1, iat) = rxyz0(1, iat)
3387 22000 : rxyz(2, iat) = rxyz0(2, iat)
3388 22022 : rxyz(3, iat) = rxyz0(3, iat)
3389 : END DO
3390 22 : il = nat
3391 : ! xy plane
3392 88 : DO l2 = 0, ll2 - 1
3393 286 : DO l1 = 0, ll1 - 1
3394 :
3395 198 : in = icell(0, l1, l2, 0)
3396 198 : icell(0, l1, l2, ll3) = in
3397 7318 : DO ii = 1, in
3398 7120 : i = icell(ii, l1, l2, 0)
3399 7120 : il = il + 1
3400 7120 : IF (il > nn) CPABORT("enlarge laymx")
3401 7120 : lay(il) = i
3402 7120 : icell(ii, l1, l2, ll3) = il
3403 7120 : rxyz(1, il) = rxyz(1, i)
3404 7120 : rxyz(2, il) = rxyz(2, i)
3405 7318 : rxyz(3, il) = rxyz(3, i) + alat(3)
3406 : END DO
3407 :
3408 198 : in = icell(0, l1, l2, ll3 - 1)
3409 198 : icell(0, l1, l2, -1) = in
3410 7444 : DO ii = 1, in
3411 7180 : i = icell(ii, l1, l2, ll3 - 1)
3412 7180 : il = il + 1
3413 7180 : IF (il > nn) CPABORT("enlarge laymx")
3414 7180 : lay(il) = i
3415 7180 : icell(ii, l1, l2, -1) = il
3416 7180 : rxyz(1, il) = rxyz(1, i)
3417 7180 : rxyz(2, il) = rxyz(2, i)
3418 7378 : rxyz(3, il) = rxyz(3, i) - alat(3)
3419 : END DO
3420 :
3421 : END DO
3422 : END DO
3423 :
3424 : ! yz plane
3425 88 : DO l3 = 0, ll3 - 1
3426 286 : DO l2 = 0, ll2 - 1
3427 :
3428 198 : in = icell(0, 0, l2, l3)
3429 198 : icell(0, ll1, l2, l3) = in
3430 7386 : DO ii = 1, in
3431 7188 : i = icell(ii, 0, l2, l3)
3432 7188 : il = il + 1
3433 7188 : IF (il > nn) CPABORT("enlarge laymx")
3434 7188 : lay(il) = i
3435 7188 : icell(ii, ll1, l2, l3) = il
3436 7188 : rxyz(1, il) = rxyz(1, i) + alat(1)
3437 7188 : rxyz(2, il) = rxyz(2, i)
3438 7386 : rxyz(3, il) = rxyz(3, i)
3439 : END DO
3440 :
3441 198 : in = icell(0, ll1 - 1, l2, l3)
3442 198 : icell(0, -1, l2, l3) = in
3443 7376 : DO ii = 1, in
3444 7112 : i = icell(ii, ll1 - 1, l2, l3)
3445 7112 : il = il + 1
3446 7112 : IF (il > nn) CPABORT("enlarge laymx")
3447 7112 : lay(il) = i
3448 7112 : icell(ii, -1, l2, l3) = il
3449 7112 : rxyz(1, il) = rxyz(1, i) - alat(1)
3450 7112 : rxyz(2, il) = rxyz(2, i)
3451 7310 : rxyz(3, il) = rxyz(3, i)
3452 : END DO
3453 :
3454 : END DO
3455 : END DO
3456 :
3457 : ! xz plane
3458 88 : DO l3 = 0, ll3 - 1
3459 286 : DO l1 = 0, ll1 - 1
3460 :
3461 198 : in = icell(0, l1, 0, l3)
3462 198 : icell(0, l1, ll2, l3) = in
3463 7452 : DO ii = 1, in
3464 7254 : i = icell(ii, l1, 0, l3)
3465 7254 : il = il + 1
3466 7254 : IF (il > nn) CPABORT("enlarge laymx")
3467 7254 : lay(il) = i
3468 7254 : icell(ii, l1, ll2, l3) = il
3469 7254 : rxyz(1, il) = rxyz(1, i)
3470 7254 : rxyz(2, il) = rxyz(2, i) + alat(2)
3471 7452 : rxyz(3, il) = rxyz(3, i)
3472 : END DO
3473 :
3474 198 : in = icell(0, l1, ll2 - 1, l3)
3475 198 : icell(0, l1, -1, l3) = in
3476 7310 : DO ii = 1, in
3477 7046 : i = icell(ii, l1, ll2 - 1, l3)
3478 7046 : il = il + 1
3479 7046 : IF (il > nn) CPABORT("enlarge laymx")
3480 7046 : lay(il) = i
3481 7046 : icell(ii, l1, -1, l3) = il
3482 7046 : rxyz(1, il) = rxyz(1, i)
3483 7046 : rxyz(2, il) = rxyz(2, i) - alat(2)
3484 7244 : rxyz(3, il) = rxyz(3, i)
3485 : END DO
3486 :
3487 : END DO
3488 : END DO
3489 :
3490 : ! x axis
3491 88 : DO l1 = 0, ll1 - 1
3492 :
3493 66 : in = icell(0, l1, 0, 0)
3494 66 : icell(0, l1, ll2, ll3) = in
3495 2474 : DO ii = 1, in
3496 2408 : i = icell(ii, l1, 0, 0)
3497 2408 : il = il + 1
3498 2408 : IF (il > nn) CPABORT("enlarge laymx")
3499 2408 : lay(il) = i
3500 2408 : icell(ii, l1, ll2, ll3) = il
3501 2408 : rxyz(1, il) = rxyz(1, i)
3502 2408 : rxyz(2, il) = rxyz(2, i) + alat(2)
3503 2474 : rxyz(3, il) = rxyz(3, i) + alat(3)
3504 : END DO
3505 :
3506 66 : in = icell(0, l1, 0, ll3 - 1)
3507 66 : icell(0, l1, ll2, -1) = in
3508 2416 : DO ii = 1, in
3509 2350 : i = icell(ii, l1, 0, ll3 - 1)
3510 2350 : il = il + 1
3511 2350 : IF (il > nn) CPABORT("enlarge laymx")
3512 2350 : lay(il) = i
3513 2350 : icell(ii, l1, ll2, -1) = il
3514 2350 : rxyz(1, il) = rxyz(1, i)
3515 2350 : rxyz(2, il) = rxyz(2, i) + alat(2)
3516 2416 : rxyz(3, il) = rxyz(3, i) - alat(3)
3517 : END DO
3518 :
3519 66 : in = icell(0, l1, ll2 - 1, 0)
3520 66 : icell(0, l1, -1, ll3) = in
3521 2278 : DO ii = 1, in
3522 2212 : i = icell(ii, l1, ll2 - 1, 0)
3523 2212 : il = il + 1
3524 2212 : IF (il > nn) CPABORT("enlarge laymx")
3525 2212 : lay(il) = i
3526 2212 : icell(ii, l1, -1, ll3) = il
3527 2212 : rxyz(1, il) = rxyz(1, i)
3528 2212 : rxyz(2, il) = rxyz(2, i) - alat(2)
3529 2278 : rxyz(3, il) = rxyz(3, i) + alat(3)
3530 : END DO
3531 :
3532 66 : in = icell(0, l1, ll2 - 1, ll3 - 1)
3533 66 : icell(0, l1, -1, -1) = in
3534 2468 : DO ii = 1, in
3535 2380 : i = icell(ii, l1, ll2 - 1, ll3 - 1)
3536 2380 : il = il + 1
3537 2380 : IF (il > nn) CPABORT("enlarge laymx")
3538 2380 : lay(il) = i
3539 2380 : icell(ii, l1, -1, -1) = il
3540 2380 : rxyz(1, il) = rxyz(1, i)
3541 2380 : rxyz(2, il) = rxyz(2, i) - alat(2)
3542 2446 : rxyz(3, il) = rxyz(3, i) - alat(3)
3543 : END DO
3544 :
3545 : END DO
3546 :
3547 : ! y axis
3548 88 : DO l2 = 0, ll2 - 1
3549 :
3550 66 : in = icell(0, 0, l2, 0)
3551 66 : icell(0, ll1, l2, ll3) = in
3552 2338 : DO ii = 1, in
3553 2272 : i = icell(ii, 0, l2, 0)
3554 2272 : il = il + 1
3555 2272 : IF (il > nn) CPABORT("enlarge laymx")
3556 2272 : lay(il) = i
3557 2272 : icell(ii, ll1, l2, ll3) = il
3558 2272 : rxyz(1, il) = rxyz(1, i) + alat(1)
3559 2272 : rxyz(2, il) = rxyz(2, i)
3560 2338 : rxyz(3, il) = rxyz(3, i) + alat(3)
3561 : END DO
3562 :
3563 66 : in = icell(0, 0, l2, ll3 - 1)
3564 66 : icell(0, ll1, l2, -1) = in
3565 2454 : DO ii = 1, in
3566 2388 : i = icell(ii, 0, l2, ll3 - 1)
3567 2388 : il = il + 1
3568 2388 : IF (il > nn) CPABORT("enlarge laymx")
3569 2388 : lay(il) = i
3570 2388 : icell(ii, ll1, l2, -1) = il
3571 2388 : rxyz(1, il) = rxyz(1, i) + alat(1)
3572 2388 : rxyz(2, il) = rxyz(2, i)
3573 2454 : rxyz(3, il) = rxyz(3, i) - alat(3)
3574 : END DO
3575 :
3576 66 : in = icell(0, ll1 - 1, l2, 0)
3577 66 : icell(0, -1, l2, ll3) = in
3578 2394 : DO ii = 1, in
3579 2328 : i = icell(ii, ll1 - 1, l2, 0)
3580 2328 : il = il + 1
3581 2328 : IF (il > nn) CPABORT("enlarge laymx")
3582 2328 : lay(il) = i
3583 2328 : icell(ii, -1, l2, ll3) = il
3584 2328 : rxyz(1, il) = rxyz(1, i) - alat(1)
3585 2328 : rxyz(2, il) = rxyz(2, i)
3586 2394 : rxyz(3, il) = rxyz(3, i) + alat(3)
3587 : END DO
3588 :
3589 66 : in = icell(0, ll1 - 1, l2, ll3 - 1)
3590 66 : icell(0, -1, l2, -1) = in
3591 2450 : DO ii = 1, in
3592 2362 : i = icell(ii, ll1 - 1, l2, ll3 - 1)
3593 2362 : il = il + 1
3594 2362 : IF (il > nn) CPABORT("enlarge laymx")
3595 2362 : lay(il) = i
3596 2362 : icell(ii, -1, l2, -1) = il
3597 2362 : rxyz(1, il) = rxyz(1, i) - alat(1)
3598 2362 : rxyz(2, il) = rxyz(2, i)
3599 2428 : rxyz(3, il) = rxyz(3, i) - alat(3)
3600 : END DO
3601 :
3602 : END DO
3603 :
3604 : ! z axis
3605 88 : DO l3 = 0, ll3 - 1
3606 :
3607 66 : in = icell(0, 0, 0, l3)
3608 66 : icell(0, ll1, ll2, l3) = in
3609 2496 : DO ii = 1, in
3610 2430 : i = icell(ii, 0, 0, l3)
3611 2430 : il = il + 1
3612 2430 : IF (il > nn) CPABORT("enlarge laymx")
3613 2430 : lay(il) = i
3614 2430 : icell(ii, ll1, ll2, l3) = il
3615 2430 : rxyz(1, il) = rxyz(1, i) + alat(1)
3616 2430 : rxyz(2, il) = rxyz(2, i) + alat(2)
3617 2496 : rxyz(3, il) = rxyz(3, i)
3618 : END DO
3619 :
3620 66 : in = icell(0, ll1 - 1, 0, l3)
3621 66 : icell(0, -1, ll2, l3) = in
3622 2396 : DO ii = 1, in
3623 2330 : i = icell(ii, ll1 - 1, 0, l3)
3624 2330 : il = il + 1
3625 2330 : IF (il > nn) CPABORT("enlarge laymx")
3626 2330 : lay(il) = i
3627 2330 : icell(ii, -1, ll2, l3) = il
3628 2330 : rxyz(1, il) = rxyz(1, i) - alat(1)
3629 2330 : rxyz(2, il) = rxyz(2, i) + alat(2)
3630 2396 : rxyz(3, il) = rxyz(3, i)
3631 : END DO
3632 :
3633 66 : in = icell(0, 0, ll2 - 1, l3)
3634 66 : icell(0, ll1, -1, l3) = in
3635 2344 : DO ii = 1, in
3636 2278 : i = icell(ii, 0, ll2 - 1, l3)
3637 2278 : il = il + 1
3638 2278 : IF (il > nn) CPABORT("enlarge laymx")
3639 2278 : lay(il) = i
3640 2278 : icell(ii, ll1, -1, l3) = il
3641 2278 : rxyz(1, il) = rxyz(1, i) + alat(1)
3642 2278 : rxyz(2, il) = rxyz(2, i) - alat(2)
3643 2344 : rxyz(3, il) = rxyz(3, i)
3644 : END DO
3645 :
3646 66 : in = icell(0, ll1 - 1, ll2 - 1, l3)
3647 66 : icell(0, -1, -1, l3) = in
3648 2400 : DO ii = 1, in
3649 2312 : i = icell(ii, ll1 - 1, ll2 - 1, l3)
3650 2312 : il = il + 1
3651 2312 : IF (il > nn) CPABORT("enlarge laymx")
3652 2312 : lay(il) = i
3653 2312 : icell(ii, -1, -1, l3) = il
3654 2312 : rxyz(1, il) = rxyz(1, i) - alat(1)
3655 2312 : rxyz(2, il) = rxyz(2, i) - alat(2)
3656 2378 : rxyz(3, il) = rxyz(3, i)
3657 : END DO
3658 :
3659 : END DO
3660 :
3661 : ! corners
3662 22 : in = icell(0, 0, 0, 0)
3663 22 : icell(0, ll1, ll2, ll3) = in
3664 774 : DO ii = 1, in
3665 752 : i = icell(ii, 0, 0, 0)
3666 752 : il = il + 1
3667 752 : IF (il > nn) CPABORT("enlarge laymx")
3668 752 : lay(il) = i
3669 752 : icell(ii, ll1, ll2, ll3) = il
3670 752 : rxyz(1, il) = rxyz(1, i) + alat(1)
3671 752 : rxyz(2, il) = rxyz(2, i) + alat(2)
3672 774 : rxyz(3, il) = rxyz(3, i) + alat(3)
3673 : END DO
3674 :
3675 22 : in = icell(0, ll1 - 1, 0, 0)
3676 22 : icell(0, -1, ll2, ll3) = in
3677 794 : DO ii = 1, in
3678 772 : i = icell(ii, ll1 - 1, 0, 0)
3679 772 : il = il + 1
3680 772 : IF (il > nn) CPABORT("enlarge laymx")
3681 772 : lay(il) = i
3682 772 : icell(ii, -1, ll2, ll3) = il
3683 772 : rxyz(1, il) = rxyz(1, i) - alat(1)
3684 772 : rxyz(2, il) = rxyz(2, i) + alat(2)
3685 794 : rxyz(3, il) = rxyz(3, i) + alat(3)
3686 : END DO
3687 :
3688 22 : in = icell(0, 0, ll2 - 1, 0)
3689 22 : icell(0, ll1, -1, ll3) = in
3690 718 : DO ii = 1, in
3691 696 : i = icell(ii, 0, ll2 - 1, 0)
3692 696 : il = il + 1
3693 696 : IF (il > nn) CPABORT("enlarge laymx")
3694 696 : lay(il) = i
3695 696 : icell(ii, ll1, -1, ll3) = il
3696 696 : rxyz(1, il) = rxyz(1, i) + alat(1)
3697 696 : rxyz(2, il) = rxyz(2, i) - alat(2)
3698 718 : rxyz(3, il) = rxyz(3, i) + alat(3)
3699 : END DO
3700 :
3701 22 : in = icell(0, ll1 - 1, ll2 - 1, 0)
3702 22 : icell(0, -1, -1, ll3) = in
3703 786 : DO ii = 1, in
3704 764 : i = icell(ii, ll1 - 1, ll2 - 1, 0)
3705 764 : il = il + 1
3706 764 : IF (il > nn) CPABORT("enlarge laymx")
3707 764 : lay(il) = i
3708 764 : icell(ii, -1, -1, ll3) = il
3709 764 : rxyz(1, il) = rxyz(1, i) - alat(1)
3710 764 : rxyz(2, il) = rxyz(2, i) - alat(2)
3711 786 : rxyz(3, il) = rxyz(3, i) + alat(3)
3712 : END DO
3713 :
3714 22 : in = icell(0, 0, 0, ll3 - 1)
3715 22 : icell(0, ll1, ll2, -1) = in
3716 874 : DO ii = 1, in
3717 852 : i = icell(ii, 0, 0, ll3 - 1)
3718 852 : il = il + 1
3719 852 : IF (il > nn) CPABORT("enlarge laymx")
3720 852 : lay(il) = i
3721 852 : icell(ii, ll1, ll2, -1) = il
3722 852 : rxyz(1, il) = rxyz(1, i) + alat(1)
3723 852 : rxyz(2, il) = rxyz(2, i) + alat(2)
3724 874 : rxyz(3, il) = rxyz(3, i) - alat(3)
3725 : END DO
3726 :
3727 22 : in = icell(0, ll1 - 1, 0, ll3 - 1)
3728 22 : icell(0, -1, ll2, -1) = in
3729 768 : DO ii = 1, in
3730 746 : i = icell(ii, ll1 - 1, 0, ll3 - 1)
3731 746 : il = il + 1
3732 746 : IF (il > nn) CPABORT("enlarge laymx")
3733 746 : lay(il) = i
3734 746 : icell(ii, -1, ll2, -1) = il
3735 746 : rxyz(1, il) = rxyz(1, i) - alat(1)
3736 746 : rxyz(2, il) = rxyz(2, i) + alat(2)
3737 768 : rxyz(3, il) = rxyz(3, i) - alat(3)
3738 : END DO
3739 :
3740 22 : in = icell(0, 0, ll2 - 1, ll3 - 1)
3741 22 : icell(0, ll1, -1, -1) = in
3742 786 : DO ii = 1, in
3743 764 : i = icell(ii, 0, ll2 - 1, ll3 - 1)
3744 764 : il = il + 1
3745 764 : IF (il > nn) CPABORT("enlarge laymx")
3746 764 : lay(il) = i
3747 764 : icell(ii, ll1, -1, -1) = il
3748 764 : rxyz(1, il) = rxyz(1, i) + alat(1)
3749 764 : rxyz(2, il) = rxyz(2, i) - alat(2)
3750 786 : rxyz(3, il) = rxyz(3, i) - alat(3)
3751 : END DO
3752 :
3753 22 : in = icell(0, ll1 - 1, ll2 - 1, ll3 - 1)
3754 22 : icell(0, -1, -1, -1) = in
3755 814 : DO ii = 1, in
3756 792 : i = icell(ii, ll1 - 1, ll2 - 1, ll3 - 1)
3757 792 : il = il + 1
3758 792 : IF (il > nn) CPABORT("enlarge laymx")
3759 792 : lay(il) = i
3760 792 : icell(ii, -1, -1, -1) = il
3761 792 : rxyz(1, il) = rxyz(1, i) - alat(1)
3762 792 : rxyz(2, il) = rxyz(2, i) - alat(2)
3763 814 : rxyz(3, il) = rxyz(3, i) - alat(3)
3764 : END DO
3765 :
3766 66 : ALLOCATE (lsta(2, nat))
3767 22 : nnbrx = 300
3768 0 : DO
3769 22 : nnbrx = 3*nnbrx/2
3770 110 : ALLOCATE (lstb(nnbrx*nat), rel(5, nnbrx*nat))
3771 :
3772 22 : indlstx = 0
3773 :
3774 22 : npr = 1
3775 22 : iam = 0
3776 :
3777 22 : cut2 = cut**2
3778 : ! assign contiguous portions of the arrays lstb and rel to the threads (this version only contains one thread)
3779 22 : myspace = (nat*nnbrx)/npr
3780 : IF (iam == 0) myspaceout = myspace
3781 : ! Verlet list, relative positions
3782 22 : indlst = 0
3783 88 : DO l3 = 0, ll3 - 1
3784 286 : DO l2 = 0, ll2 - 1
3785 858 : DO l1 = 0, ll1 - 1
3786 22792 : DO ii = 1, icell(0, l1, l2, l3)
3787 22000 : iat = icell(ii, l1, l2, l3)
3788 22594 : IF (((iat - 1)*npr)/nat == iam) THEN
3789 22000 : lsta(1, iat) = iam*myspace + indlst + 1
3790 : CALL sw_sublstiat_l(iat, nn, ncx, ll1, ll2, ll3, l1, l2, l3, myspace, &
3791 22000 : rxyz, icell, lstb(iam*myspace + 1), lay, rel(1, iam*myspace + 1), cut2, indlst)
3792 22000 : lsta(2, iat) = iam*myspace + indlst
3793 22000 : ipb = lsta(1, iat)
3794 22000 : ndat = lsta(2, iat) - lsta(1, iat) + 1
3795 : END IF
3796 : END DO
3797 : END DO
3798 : END DO
3799 : END DO
3800 22 : indlstx = MAX(indlstx, indlst)
3801 :
3802 22 : IF (indlstx < myspaceout) EXIT
3803 22 : DEALLOCATE (lstb, rel)
3804 : END DO
3805 :
3806 22 : npr = 1
3807 22 : iam = 0
3808 22 : npjx = 300; npjkx = 6000
3809 : !end of creating pairlist part------------------------------------------------------------
3810 :
3811 : !start energy and force calculation-------------------------------------------------------
3812 : !set all variables to zero
3813 22 : p = 0.0_dp
3814 22 : p3 = 0.0_dp
3815 22 : pv3 = 0.0_dp
3816 22022 : fx(:) = 0.0_dp
3817 22022 : fy(:) = 0.0_dp
3818 22022 : fz(:) = 0.0_dp
3819 22022 : fx3(:) = 0.0_dp
3820 22022 : fy3(:) = 0.0_dp
3821 22022 : fz3(:) = 0.0_dp
3822 : !-----------------------------------------------------------------------------------------
3823 : ! triple loop for the 2 and 3-body forces
3824 : ! do 20 i
3825 : ! do 30 j
3826 : ! do 40 k
3827 : ! the pairlists lsta and lstb are used for the perodic boundary conditions
3828 : !-----------------------------------------------------------------------------------------
3829 :
3830 22022 : DO i = 1, nat
3831 22022 : CALL sw_subfeniat_l(i, nat, nnbrx, rel, p, p3, fx, fy, fz, fx3, fy3, fz3, lstb, lsta, isigma, sigma)
3832 : END DO
3833 : !-----------------------------------------------------------------------------------------
3834 : !*****if necessary,********
3835 22022 : DO i = 1, nat
3836 22000 : fx(i) = fx(i) + fx3(i)
3837 22000 : fy(i) = fy(i) + fy3(i)
3838 22022 : fz(i) = fz(i) + fz3(i)
3839 : END DO
3840 : !-----------------------------------------------------------------------------------------
3841 :
3842 22022 : DO i = 1, nat
3843 22000 : fxyz(1, i) = fx(i)*esigma
3844 22000 : fxyz(2, i) = fy(i)*esigma
3845 22022 : fxyz(3, i) = fz(i)*esigma
3846 : END DO
3847 22 : etot = (p + p3)*eps
3848 22 : DEALLOCATE (rxyz, icell, lay, lsta, lstb, rel)
3849 22 : END SUBROUTINE eip_stillinger_weber_silicon
3850 : !End of the force calculation-------------------------------------------------------------
3851 :
3852 : ! **************************************************************************************************
3853 : !> \brief ...
3854 : !> \param c ...
3855 : !> \return ...
3856 : ! **************************************************************************************************
3857 0 : REAL(KIND=dp) FUNCTION f(c)
3858 : REAL(KIND=dp) :: c
3859 :
3860 : REAL(KIND=dp), PARAMETER :: aa = 7.049556277_dp, &
3861 : bb = 0.6022245584_dp, ra = 1.8_dp
3862 :
3863 : REAL(KIND=dp) :: c4, crainv
3864 :
3865 0 : IF ((c - ra) < 0._dp) THEN
3866 0 : crainv = 1.0_dp/(c - ra)
3867 0 : c4 = c*c*c*c
3868 0 : f = aa*bb*4.0_dp/(c4*c)*EXP(crainv) + aa*(bb/(c4) - 1.0_dp)*EXP(crainv)*crainv*crainv
3869 : ELSE
3870 : f = 0._dp
3871 : END IF
3872 :
3873 0 : END FUNCTION f
3874 :
3875 : ! **************************************************************************************************
3876 : !> \brief ...
3877 : !> \param d ...
3878 : !> \return ...
3879 : ! **************************************************************************************************
3880 0 : REAL(KIND=dp) FUNCTION pe(d)
3881 : REAL(KIND=dp) :: d
3882 :
3883 : REAL(KIND=dp), PARAMETER :: aa = 7.049556277_dp, &
3884 : bb = 0.6022245584_dp, ra = 1.8_dp
3885 :
3886 0 : IF ((d - ra) < 0._dp) THEN
3887 0 : pe = aa*(bb/(d*d*d*d) - 1.0_dp)*EXP(1.0_dp/(d - ra))
3888 : ELSE
3889 : pe = 0._dp
3890 : END IF
3891 0 : END FUNCTION pe
3892 :
3893 : !------------------------------------------------------------------------------------------
3894 : ! **************************************************************************************************
3895 : !> \brief ...
3896 : !> \param iat ...
3897 : !> \param nn ...
3898 : !> \param ncx ...
3899 : !> \param ll1 ...
3900 : !> \param ll2 ...
3901 : !> \param ll3 ...
3902 : !> \param l1 ...
3903 : !> \param l2 ...
3904 : !> \param l3 ...
3905 : !> \param myspace ...
3906 : !> \param rxyz ...
3907 : !> \param icell ...
3908 : !> \param lstb ...
3909 : !> \param lay ...
3910 : !> \param rel ...
3911 : !> \param cut2 ...
3912 : !> \param indlst ...
3913 : ! **************************************************************************************************
3914 22000 : SUBROUTINE sw_sublstiat_l(iat, nn, ncx, ll1, ll2, ll3, l1, l2, l3, myspace, &
3915 22000 : rxyz, icell, lstb, lay, rel, cut2, indlst)
3916 : ! finds the neighbours of atom iat (specified by lsta and lstb) and and
3917 : ! the relative position rel of iat with respect to these neighbours
3918 : INTEGER :: iat, nn, ncx, ll1, ll2, ll3, l1, l2, l3, &
3919 : myspace
3920 : REAL(KIND=dp) :: rxyz(3, nn)
3921 : INTEGER :: icell(0:ncx, -1:ll1, -1:ll2, -1:ll3), lstb(0:myspace - 1), lay(nn)
3922 : REAL(KIND=dp) :: rel(5, 0:myspace - 1), cut2
3923 : INTEGER :: indlst
3924 :
3925 : INTEGER :: jat, jj, k1, k2, k3
3926 : REAL(KIND=dp) :: rr2, tt, tti, xrel, yrel, zrel
3927 :
3928 88000 : DO k3 = l3 - 1, l3 + 1
3929 286000 : DO k2 = l2 - 1, l2 + 1
3930 858000 : DO k1 = l1 - 1, l1 + 1
3931 22792000 : DO jj = 1, icell(0, k1, k2, k3)
3932 22000000 : jat = icell(jj, k1, k2, k3)
3933 22000000 : IF (jat == iat) CYCLE
3934 21978000 : xrel = rxyz(1, iat) - rxyz(1, jat)
3935 21978000 : yrel = rxyz(2, iat) - rxyz(2, jat)
3936 21978000 : zrel = rxyz(3, iat) - rxyz(3, jat)
3937 21978000 : rr2 = xrel**2 + yrel**2 + zrel**2
3938 22572000 : IF (rr2 <= cut2) THEN
3939 1892004 : indlst = MIN(indlst, myspace - 1)
3940 1892004 : lstb(indlst) = lay(jat)
3941 : ! write(6,*) 'iat,indlst,lay(jat)',iat,indlst,lay(jat)
3942 1892004 : tt = SQRT(rr2)
3943 1892004 : tti = 1._dp/tt
3944 1892004 : rel(1, indlst) = xrel*tti
3945 1892004 : rel(2, indlst) = yrel*tti
3946 1892004 : rel(3, indlst) = zrel*tti
3947 1892004 : rel(4, indlst) = tt
3948 1892004 : rel(5, indlst) = tti
3949 1892004 : indlst = indlst + 1
3950 : END IF
3951 : END DO
3952 : END DO
3953 : END DO
3954 : END DO
3955 :
3956 22000 : RETURN
3957 : END SUBROUTINE sw_sublstiat_l
3958 :
3959 : ! **************************************************************************************************
3960 : !> \brief ...
3961 : !> \param i ...
3962 : !> \param nat ...
3963 : !> \param nnbrx ...
3964 : !> \param rel ...
3965 : !> \param p ...
3966 : !> \param p3 ...
3967 : !> \param fx ...
3968 : !> \param fy ...
3969 : !> \param fz ...
3970 : !> \param fx3 ...
3971 : !> \param fy3 ...
3972 : !> \param fz3 ...
3973 : !> \param lstb ...
3974 : !> \param lsta ...
3975 : !> \param isigma ...
3976 : !> \param sigma ...
3977 : ! **************************************************************************************************
3978 22000 : SUBROUTINE sw_subfeniat_l(i, nat, nnbrx, rel, p, p3, fx, fy, fz, fx3, fy3, fz3, lstb, lsta, isigma, sigma)
3979 : INTEGER, INTENT(IN) :: i, nat, nnbrx
3980 : REAL(KIND=dp), INTENT(IN) :: rel(5, nnbrx*nat)
3981 : REAL(KIND=dp), INTENT(INOUT) :: p, p3, fx(nat), fy(nat), fz(nat), &
3982 : fx3(nat), fy3(nat), fz3(nat)
3983 : INTEGER, INTENT(IN) :: lstb(nnbrx*nat), lsta(2, nat)
3984 : REAL(KIND=dp), INTENT(IN) :: isigma, sigma
3985 :
3986 : REAL(KIND=dp), PARAMETER :: aa = 7.049556277_dp, &
3987 : bb = 0.6022245584_dp, gam = 1.2_dp, &
3988 : ra = 1.8_dp, ramda = 21.0_dp
3989 :
3990 : INTEGER :: Ipb, Ipe, j, k, l, m, nij
3991 : REAL(KIND=dp) :: c4, cosijk, cosijk3, cosikj, cosikj3, cosjik, cosjik3, crainv, force, hi, &
3992 : hixij, hixij0, hixij1, hixik, hixik0, hixik1, hiyij, hiyij0, hiyij1, hiyik, hiyik0, &
3993 : hiyik1, HIZIJ, HIZIJ0, HIZIJ1, HIZIK, HIZIK0, HIZIK1, hj, hjxij, hjxij0, hjxij1, hjxjk, &
3994 : hjxjk0, hjxjk1, hjyij, hjyij0, hjyij1, hjyjk, hjyjk0, hjyjk1, HJZIJ, HJZIJ0, HJZIJ1, &
3995 : HJZJK, HJZJK0, HJZJK1, hk, hkxik, hkxik0, HKXIK1, hkxkj, hkxkj0, hkxkj1, hkyik, hkyik0, &
3996 : hkyik1, hkykj, hkykj0, hkykj1, HKZIK, HKZIK0, HKZIK1, HKZKJ, HKZKJ0, HKZKJ1, invrij, &
3997 : invrija, invrik, invrika, invrjk, invrjka, refi, refj, refk, rij, rija, rik
3998 : REAL(KIND=dp) :: rika, rjk, rjka, xij, xik, xjk, yij, yik, yjk, zij, zik, zjk
3999 :
4000 22000 : Ipb = lsta(1, i)
4001 22000 : Ipe = lsta(2, i)
4002 :
4003 1914004 : DO l = Ipb, Ipe
4004 1892004 : j = lstb(l)
4005 1892004 : IF (j <= i) CYCLE
4006 946002 : nij = 0
4007 946002 : rij = rel(4, l)*isigma
4008 946002 : invrij = rel(5, l)*sigma
4009 946002 : xij = rel(1, l)*rij
4010 946002 : yij = rel(2, l)*rij
4011 946002 : zij = rel(3, l)*rij
4012 :
4013 946002 : IF (rij >= 2._dp*ra) CYCLE
4014 946002 : IF (rij < ra) THEN
4015 44942 : crainv = 1.0_dp/(rij - ra)
4016 44942 : c4 = rij*rij*rij*rij
4017 44942 : force = aa*bb*4.0_dp/(c4*rij)*EXP(crainv) + aa*(bb/(c4) - 1.0_dp)*EXP(crainv)*crainv*crainv
4018 :
4019 44942 : fx(i) = force*xij*invrij + fx(i)
4020 44942 : fy(i) = force*yij*invrij + fy(i)
4021 44942 : fz(i) = force*zij*invrij + fz(i)
4022 :
4023 44942 : fx(j) = -force*xij*invrij + fx(j)
4024 44942 : fy(j) = -force*yij*invrij + fy(j)
4025 44942 : fz(j) = -force*zij*invrij + fz(j)
4026 :
4027 44942 : p = p + aa*(bb/(rij*rij*rij*rij) - 1.0_dp)*EXP(1.0_dp/(rij - ra))
4028 :
4029 44942 : nij = 1
4030 : END IF
4031 :
4032 82324312 : DO m = Ipb, Ipe
4033 81356310 : k = lstb(m)
4034 81356310 : IF (k <= j) CYCLE
4035 23689448 : invrik = rel(5, m)*sigma
4036 23689448 : rik = rel(4, m)*isigma
4037 23689448 : xik = rel(1, m)*rik
4038 23689448 : yik = rel(2, m)*rik
4039 23689448 : zik = rel(3, m)*rik
4040 :
4041 23689448 : IF ((rik >= ra) .AND. (nij == 0)) CYCLE
4042 :
4043 2130678 : xjk = xik - xij
4044 2130678 : yjk = yik - yij
4045 2130678 : zjk = zik - zij
4046 :
4047 2130678 : rjk = SQRT(xjk*xjk + yjk*yjk + zjk*zjk)
4048 2130678 : invrjk = 1._dp/rjk
4049 :
4050 2130678 : IF ((rjk >= ra) .AND. (nij == 0)) CYCLE
4051 1551074 : cosjik = (xij*xik + yij*yik + zij*zik)*(invrij*invrik)
4052 1551074 : cosijk = (-xij*xjk - yij*yjk - zij*zjk)*(invrij*invrjk)
4053 1551074 : cosikj = (xik*xjk + yik*yjk + zik*zjk)*(invrik*invrjk)
4054 1551074 : cosjik3 = cosjik + 1.0_dp/3.0_dp
4055 1551074 : cosijk3 = cosijk + 1.0_dp/3.0_dp
4056 1551074 : cosikj3 = cosikj + 1.0_dp/3.0_dp
4057 :
4058 1551074 : rija = rij - ra
4059 1551074 : rika = rik - ra
4060 1551074 : rjka = rjk - ra
4061 :
4062 1551074 : invrija = 1._dp/rija
4063 1551074 : invrika = 1._dp/rika
4064 1551074 : invrjka = 1._dp/rjka
4065 :
4066 1551074 : IF (rija >= 0.0_dp) THEN
4067 37312 : refi = 0.0_dp
4068 37312 : refj = 0.0_dp
4069 37312 : refk = ramda*EXP(gam*invrika + gam*invrjka)
4070 1513762 : ELSE IF ((rija < 0.0_dp) .AND. (rika < 0.0_dp)) THEN
4071 38074 : IF (rjka < 0.0_dp) THEN
4072 950 : refi = ramda*EXP(gam*invrija + gam*invrika)
4073 950 : refj = ramda*EXP(gam*invrija + gam*invrjka)
4074 950 : refk = ramda*EXP(gam*invrika + gam*invrjka)
4075 : ELSE
4076 37124 : refi = ramda*EXP(gam*invrija + gam*invrika)
4077 37124 : refj = 0.0_dp
4078 37124 : refk = 0.0_dp
4079 : END IF
4080 1475688 : ELSE IF ((rija < 0.0_dp) .AND. (rjka < 0.0_dp)) THEN
4081 62588 : refi = 0.0_dp
4082 62588 : refj = ramda*EXP(gam*invrija + gam*invrjka)
4083 62588 : refk = 0.0_dp
4084 : ELSE
4085 : CYCLE
4086 : END IF
4087 :
4088 137974 : hi = refi*cosjik3*cosjik3
4089 137974 : hj = refj*cosijk3*cosijk3
4090 137974 : hk = refk*cosikj3*cosikj3
4091 137974 : p3 = p3 + hi + hj + hk
4092 :
4093 137974 : hixij0 = 2.0_dp*(xik*invrik - xij*cosjik*invrij)
4094 137974 : hixij1 = gam*xij*cosjik3*(invrija*invrija)
4095 137974 : hixij = refi*cosjik3*(hixij0 - hixij1)*invrij
4096 137974 : hixik0 = 2.0_dp*(xij*invrij - xik*cosjik*invrik)
4097 137974 : hixik1 = gam*xik*cosjik3*(invrika*invrika)
4098 137974 : hixik = refi*cosjik3*(hixik0 - hixik1)*invrik
4099 137974 : hjxij0 = 2.0_dp*(-xjk*invrjk - xij*cosijk*invrij)
4100 137974 : hjxij1 = gam*xij*cosijk3*(invrija*invrija)
4101 137974 : hjxij = refj*cosijk3*(hjxij0 - hjxij1)*invrij
4102 137974 : hkxik0 = 2.0_dp*(xjk*invrjk - xik*cosikj*invrik)
4103 137974 : hkxik1 = gam*xik*cosikj3*(invrika*invrika)
4104 137974 : hkxik = refk*cosikj3*(hkxik0 - hkxik1)*invrik
4105 137974 : hjxjk0 = 2.0_dp*(-xij*invrij - xjk*cosijk*invrjk)
4106 137974 : hjxjk1 = gam*xjk*cosijk3*(invrjka*invrjka)
4107 137974 : hjxjk = refj*cosijk3*(hjxjk0 - hjxjk1)*invrjk
4108 137974 : hkxkj0 = 2.0_dp*(-xik*invrik + xjk*cosikj*invrjk)
4109 137974 : hkxkj1 = gam*xjk*cosikj3*(invrjka*invrjka)
4110 137974 : hkxkj = refk*cosikj3*(hkxkj0 + hkxkj1)*invrjk
4111 :
4112 137974 : hiyij0 = 2.0_dp*(yik*invrik - yij*cosjik*invrij)
4113 137974 : hiyij1 = gam*yij*cosjik3*(invrija*invrija)
4114 137974 : hiyij = refi*cosjik3*(hiyij0 - hiyij1)*invrij
4115 137974 : hiyik0 = 2.0_dp*(yij*invrij - yik*cosjik*invrik)
4116 137974 : hiyik1 = gam*yik*cosjik3*(invrika*invrika)
4117 137974 : hiyik = refi*cosjik3*(hiyik0 - hiyik1)*invrik
4118 137974 : hjyij0 = 2.0_dp*(-yjk*invrjk - yij*cosijk*invrij)
4119 137974 : hjyij1 = gam*yij*cosijk3*(invrija*invrija)
4120 137974 : hjyij = refj*cosijk3*(hjyij0 - hjyij1)*invrij
4121 137974 : hkyik0 = 2.0_dp*(yjk*invrjk - yik*cosikj*invrik)
4122 137974 : hkyik1 = gam*yik*cosikj3*(invrika*invrika)
4123 137974 : hkyik = refk*cosikj3*(hkyik0 - hkyik1)*invrik
4124 137974 : hjyjk0 = 2.0_dp*(-yij*invrij - yjk*cosijk*invrjk)
4125 137974 : hjyjk1 = gam*yjk*cosijk3*(invrjka*invrjka)
4126 137974 : hjyjk = refj*cosijk3*(hjyjk0 - hjyjk1)*invrjk
4127 137974 : hkykj0 = 2.0_dp*(-yik*invrik + yjk*cosikj*invrjk)
4128 137974 : hkykj1 = gam*yjk*cosikj3*(invrjka*invrjka)
4129 137974 : hkykj = refk*cosikj3*(hkykj0 + hkykj1)*invrjk
4130 :
4131 137974 : hizij0 = 2.0_dp*(zik*invrik - zij*cosjik*invrij)
4132 137974 : hizij1 = gam*zij*cosjik3*(invrija*invrija)
4133 137974 : hizij = refi*cosjik3*(hizij0 - hizij1)*invrij
4134 137974 : hizik0 = 2.0_dp*(zij*invrij - zik*cosjik*invrik)
4135 137974 : hizik1 = gam*zik*cosjik3*(invrika*invrika)
4136 137974 : hizik = refi*cosjik3*(hizik0 - hizik1)*invrik
4137 137974 : hjzij0 = 2.0_dp*(-zjk*invrjk - zij*cosijk*invrij)
4138 137974 : hjzij1 = gam*zij*cosijk3*(invrija*invrija)
4139 137974 : hjzij = refj*cosijk3*(hjzij0 - hjzij1)*invrij
4140 137974 : hkzik0 = 2.0_dp*(zjk*invrjk - zik*cosikj*invrik)
4141 137974 : hkzik1 = gam*zik*cosikj3*(invrika*invrika)
4142 137974 : hkzik = refk*cosikj3*(hkzik0 - hkzik1)*invrik
4143 137974 : hjzjk0 = 2.0_dp*(-zij*invrij - zjk*cosijk*invrjk)
4144 137974 : hjzjk1 = gam*zjk*cosijk3*(invrjka*invrjka)
4145 137974 : hjzjk = refj*cosijk3*(hjzjk0 - hjzjk1)*invrjk
4146 137974 : hkzkj0 = 2.0_dp*(-zik*invrik + zjk*cosikj*invrjk)
4147 137974 : hkzkj1 = gam*zjk*cosikj3*(invrjka*invrjka)
4148 137974 : hkzkj = refk*cosikj3*(hkzkj0 + hkzkj1)*invrjk
4149 :
4150 137974 : fx3(i) = fx3(i) - hixij - hixik - hjxij - hkxik
4151 137974 : fy3(i) = fy3(i) - hiyij - hiyik - hjyij - hkyik
4152 137974 : fz3(i) = fz3(i) - hizij - hizik - hjzij - hkzik
4153 :
4154 137974 : fx3(j) = fx3(j) + hixij + hjxij - hjxjk + hkxkj
4155 137974 : fy3(j) = fy3(j) + hiyij + hjyij - hjyjk + hkykj
4156 137974 : fz3(j) = fz3(j) + hizij + hjzij - hjzjk + hkzkj
4157 :
4158 137974 : fx3(k) = fx3(k) + hixik + hkxik - hkxkj + hjxjk
4159 137974 : fy3(k) = fy3(k) + hiyik + hkyik - hkykj + hjyjk
4160 83248314 : fz3(k) = fz3(k) + hizik + hkzik - hkzkj + hjzjk
4161 : END DO
4162 : END DO
4163 22000 : END SUBROUTINE sw_subfeniat_l
4164 :
4165 : ! **************************************************************************************************
4166 : !> \brief ...
4167 : !> \param nat ...
4168 : !> \param alat ...
4169 : !> \param rxyz ...
4170 : !> \param fxyz ...
4171 : !> \param etot ...
4172 : !> \param count ...
4173 : ! **************************************************************************************************
4174 22 : SUBROUTINE eip_tersoff_silicon(nat, alat, rxyz, fxyz, etot, count)
4175 : !*****************************************************************************************
4176 : ! This subroutine evaluates the Tersoff Silicon potential with linear scaling
4177 : ! COPYRIGHT
4178 : ! Copyright (C) 2009 AIST, UNIBAS
4179 : ! This file is distributed under the terms of the
4180 : ! GNU General Public License, see
4181 : ! http://www.gnu.org/copyleft/gpl.txt .
4182 : !
4183 : ! Implementation: Original version was written by Kengo Nishio, AIST Tsukuba (JP)
4184 : ! Improved by M. Amsler, S. Goedecker, Basel University (CH), 2009
4185 : !
4186 : ! Note:
4187 : ! Parameters and functional form from PRL 61, 2879 (1988) and PRB 39, 5566 (1989)
4188 : !
4189 : ! Input:
4190 : ! nat, integer: the number of atoms
4191 : ! alat, REAL(KIND=dp), dim(3) : the three edges of the orthoromic simulation cell, periodic boundaries are applied
4192 : ! and atoms outside the cell will be brought back into the box
4193 : ! rxyz, REAL(KIND=dp), dim(3,nat) : the xyz cartesian components of the atomic positions in Angstroem
4194 : !
4195 : ! Output:
4196 : ! fxyz, REAL(KIND=dp), dim(3,nat): the xyz cartesian forces in on the corresponding atomic components n eV/A
4197 : ! etot, REAL(KIND=dp) : total potential energy, 2-body and 3-body, in eV
4198 : ! count, REAL(KIND=dp) : increased by 1._dp at each call of this subroutine,
4199 : ! needs to be initialized to 0._dp before calling this routine for the first time
4200 : !*****************************************************************************************
4201 : INTEGER :: nat
4202 : REAL(KIND=dp) :: alat(3), rxyz(3, nat), fxyz(3, nat), &
4203 : etot, count
4204 :
4205 : INTEGER :: iat, NNmax, Npmax
4206 22 : INTEGER, ALLOCATABLE, DIMENSION(:) :: Kinds, lstb
4207 22 : INTEGER, ALLOCATABLE, DIMENSION(:, :) :: lsta
4208 : REAL(KIND=dp) :: Uatot, Urtot, xbox, ybox, zbox
4209 22 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: dkEij, UadUrdf, XYZRrefdf
4210 : REAL(KIND=dp), DIMENSION(1:2) :: bcsq, Co_bcd, dsq, h, Pmass, Pn
4211 : REAL(KIND=dp), DIMENSION(1:2, 1:2) :: ala, alr, Ca, Cr, R1, R2, X
4212 :
4213 : INTEGER:: nnbrx, nnbrxt
4214 : INTEGER :: i
4215 :
4216 22 : count = count + 1._dp
4217 :
4218 22022 : DO iat = 1, nat
4219 22000 : rxyz(1, iat) = MODULO(MODULO(rxyz(1, iat), alat(1)), alat(1))
4220 22000 : rxyz(2, iat) = MODULO(MODULO(rxyz(2, iat), alat(2)), alat(2))
4221 22022 : rxyz(3, iat) = MODULO(MODULO(rxyz(3, iat), alat(3)), alat(3))
4222 : END DO
4223 :
4224 66 : ALLOCATE (Kinds(1:nat))
4225 :
4226 22 : nnbrx = 24
4227 22 : nnbrxt = 3*nnbrx/2
4228 22 : nnmax = nnbrxt*nat
4229 : npmax = nnbrxt*nat
4230 110 : ALLOCATE (lsta(2, nat), lstb(nnbrxt*nat))
4231 132 : ALLOCATE (XYZRrefdf(1:6*Npmax), UadUrdf(1:3*Npmax), dkEij(1:3*NNmax))
4232 :
4233 22022 : DO i = 1, nat
4234 22022 : kinds(i) = 2 !Since all atoms are Si, all of kind 2
4235 : END DO
4236 88022 : fxyz = 0.0_dp
4237 22 : xbox = alat(1); ybox = alat(2); zbox = alat(3)
4238 22 : CALL tersoff_parameters(R1, R2, Cr, Ca, alr, ala, X, Pn, Co_bcd, bcsq, dsq, h, Pmass)
4239 : CALL tersoff_pairlist_energy_forces(nat, Npmax, NNmax, xbox, ybox, zbox, Kinds, rxyz, R1, R2, Cr, &
4240 : Ca, alr, ala, X, XYZRrefdf, UadUrdf, Urtot, lsta, lstb, nnbrx, &
4241 22 : Pn, Co_bcd, bcsq, dsq, h, fxyz, Uatot, dkEij)
4242 22 : etot = Urtot + Uatot
4243 22 : DEALLOCATE (Kinds, XYZRrefdf, UadUrdf, dkEij, lsta, lstb)
4244 22 : END SUBROUTINE eip_tersoff_silicon
4245 : !-----------------------------------------------------------------------------------------
4246 : ! **************************************************************************************************
4247 : !> \brief ...
4248 : !> \param R1 ...
4249 : !> \param R2 ...
4250 : !> \param Cr ...
4251 : !> \param Ca ...
4252 : !> \param alr ...
4253 : !> \param ala ...
4254 : !> \param X ...
4255 : !> \param Pn ...
4256 : !> \param Co_bcd ...
4257 : !> \param bcsq ...
4258 : !> \param dsq ...
4259 : !> \param h ...
4260 : !> \param Pmass ...
4261 : ! **************************************************************************************************
4262 22 : SUBROUTINE tersoff_parameters(R1, R2, Cr, Ca, alr, ala, X, Pn, Co_bcd, bcsq, dsq, h, Pmass)
4263 :
4264 : REAL(KIND=dp), DIMENSION(1:2, 1:2), INTENT(out) :: R1, R2, Cr, Ca, alr, ala, X
4265 : REAL(KIND=dp), DIMENSION(1:2), INTENT(out) :: Pn, Co_bcd, bcsq, dsq, h, Pmass
4266 :
4267 : REAL(KIND=dp), PARAMETER :: C_ala = 2.2119_dp, C_alr = 3.4879_dp, C_b = 1.5724e-7_dp, &
4268 : C_c = 3.8049e4_dp, C_Ca = 3.4674e2_dp, C_Cr = 1.3936e3_dp, C_d = 4.3484_dp, &
4269 : C_h = -5.7058e-1_dp, C_mass = 12.0_dp, C_n = 7.2751e-1_dp, C_R1 = 1.8_dp, C_R2 = 2.1_dp, &
4270 : Si_ala = 1.7322_dp, Si_alr = 2.4799_dp, Si_b = 1.1000e-6_dp, Si_c = 1.0039e5_dp, &
4271 : Si_Ca = 4.7118e2_dp, Si_Cr = 1.8308e3_dp, Si_d = 1.6217e1_dp, Si_h = -5.9825e-1_dp, &
4272 : Si_mass = 28.0855_dp, Si_n = 7.8734e-1_dp, Si_R1 = 2.7_dp, Si_R2 = 3.3_dp
4273 :
4274 : !Parameter for carbon, not used in this version
4275 : !Parameter for carbon, not used in this version
4276 : !Parameter for carbon, not used in this version
4277 : !Parameter for carbon, not used in this version
4278 : !Parameter for carbon, not used in this version
4279 : !Parameter for carbon, not used in this version
4280 : !Parameter for carbon, not used in this version
4281 : !Parameter for carbon, not used in this version
4282 : !Parameter for carbon, not used in this version
4283 : !Parameter for carbon, not used in this version
4284 : !Parameter for carbon, not used in this version
4285 : !Parameter for carbon, not used in this version
4286 : !Increased Cutoff, originally 3.0_dp
4287 :
4288 22 : Cr(1, 1) = C_Cr
4289 22 : Cr(2, 2) = Si_Cr
4290 22 : Cr(1, 2) = SQRT(Cr(1, 1)*Cr(2, 2))
4291 22 : Cr(2, 1) = Cr(1, 2)
4292 :
4293 22 : Ca(1, 1) = C_Ca
4294 22 : Ca(2, 2) = Si_Ca
4295 22 : Ca(1, 2) = SQRT(Ca(1, 1)*Ca(2, 2))
4296 22 : Ca(2, 1) = Ca(1, 2)
4297 :
4298 22 : R1(1, 1) = C_R1
4299 22 : R1(2, 2) = Si_R1
4300 22 : R1(1, 2) = SQRT(R1(1, 1)*R1(2, 2))
4301 22 : R1(2, 1) = R1(1, 2)
4302 :
4303 22 : R2(1, 1) = C_R2
4304 22 : R2(2, 2) = Si_R2
4305 22 : R2(1, 2) = SQRT(R2(1, 1)*R2(2, 2))
4306 22 : R2(2, 1) = R2(1, 2)
4307 :
4308 22 : X(1, 1) = 1.0_dp
4309 22 : X(2, 2) = 1.0_dp
4310 22 : X(1, 2) = 0.9776_dp
4311 22 : X(2, 1) = 0.9776_dp
4312 :
4313 22 : alr(1, 1) = C_alr
4314 22 : alr(2, 2) = Si_alr
4315 22 : alr(1, 2) = 0.5_dp*(alr(1, 1) + alr(2, 2))
4316 22 : alr(2, 1) = alr(1, 2)
4317 :
4318 22 : ala(1, 1) = C_ala
4319 22 : ala(2, 2) = Si_ala
4320 22 : ala(1, 2) = 0.5_dp*(ala(1, 1) + ala(2, 2))
4321 22 : ala(2, 1) = ala(1, 2)
4322 :
4323 22 : Pn(1) = C_n
4324 22 : Pn(2) = Si_n
4325 :
4326 22 : Co_bcd(1) = C_b*(1.0_dp + C_c*C_c/(C_d*C_d))
4327 22 : Co_bcd(2) = Si_b*(1.0_dp + Si_c*Si_c/(Si_d*Si_d))
4328 :
4329 22 : bcsq(1) = C_b*C_c*C_c
4330 22 : bcsq(2) = Si_b*Si_c*Si_c
4331 :
4332 22 : dsq(1) = C_d*C_d
4333 22 : dsq(2) = Si_d*Si_d
4334 :
4335 22 : h(1) = C_h
4336 22 : h(2) = Si_h
4337 :
4338 22 : Pmass(1) = C_mass
4339 22 : Pmass(2) = Si_mass
4340 :
4341 22 : RETURN
4342 : END SUBROUTINE tersoff_parameters
4343 : !-----------------------------------------------------------------------------------------
4344 : ! **************************************************************************************************
4345 : !> \brief ...
4346 : !> \param Nmol ...
4347 : !> \param Npmax ...
4348 : !> \param NNmax ...
4349 : !> \param xbox ...
4350 : !> \param ybox ...
4351 : !> \param zbox ...
4352 : !> \param Kinds ...
4353 : !> \param R ...
4354 : !> \param R1 ...
4355 : !> \param R2 ...
4356 : !> \param Cr ...
4357 : !> \param Ca ...
4358 : !> \param alr ...
4359 : !> \param ala ...
4360 : !> \param X ...
4361 : !> \param XYZRrefdf ...
4362 : !> \param UadUrdf ...
4363 : !> \param Urtot ...
4364 : !> \param lsta ...
4365 : !> \param lstb ...
4366 : !> \param nnbrx ...
4367 : !> \param Pn ...
4368 : !> \param Co_bcd ...
4369 : !> \param bcsq ...
4370 : !> \param dsq ...
4371 : !> \param h ...
4372 : !> \param F ...
4373 : !> \param Uatot ...
4374 : !> \param dkEij ...
4375 : ! **************************************************************************************************
4376 22 : SUBROUTINE tersoff_pairlist_energy_forces(Nmol, Npmax, NNmax, xbox, ybox, zbox, Kinds, R, R1, R2, Cr, Ca, alr, ala, X, &
4377 22 : XYZRrefdf, UadUrdf, Urtot, lsta, lstb, nnbrx, &
4378 22 : Pn, Co_bcd, bcsq, dsq, h, F, Uatot, dkEij)
4379 : INTEGER, INTENT(in) :: Nmol, Npmax, NNmax
4380 : REAL(KIND=dp), INTENT(in) :: xbox, ybox, zbox
4381 : INTEGER, DIMENSION(1:Nmol), INTENT(in) :: Kinds
4382 : REAL(KIND=dp), DIMENSION(1:3*Nmol), INTENT(in) :: R
4383 : REAL(KIND=dp), DIMENSION(1:2, 1:2), INTENT(in) :: R1, R2, Cr, Ca, alr, ala, X
4384 : REAL(KIND=dp), DIMENSION(1:6*Npmax), INTENT(out) :: XYZRrefdf
4385 : REAL(KIND=dp), DIMENSION(1:3*Npmax), INTENT(out) :: UadUrdf
4386 : REAL(KIND=dp), INTENT(out) :: Urtot
4387 : INTEGER :: lsta(2, Nmol)
4388 : INTEGER, INTENT(inout) :: nnbrx
4389 : INTEGER :: lstb(nnbrx*Nmol)
4390 : REAL(KIND=dp), DIMENSION(1:2), INTENT(in) :: Pn, Co_bcd, bcsq, dsq, h
4391 : REAL(KIND=dp), DIMENSION(1:3*Nmol), INTENT(out) :: F
4392 : REAL(KIND=dp), INTENT(out) :: Uatot
4393 : REAL(KIND=dp), DIMENSION(1:3*NNmax) :: dkEij
4394 :
4395 : INTEGER :: i, iam, iat, ii, il, in, indlst, indlstx, Ipb, istopg, jat, l1, l2, l3, laymx, &
4396 : ll1, ll2, ll3, myspace, myspaceout, nat, ncx, ndat, nn, npjkx, npjx, npr, Nptot
4397 22 : INTEGER, ALLOCATABLE, DIMENSION(:) :: lay
4398 22 : INTEGER, ALLOCATABLE, DIMENSION(:, :, :, :) :: icell
4399 : REAL(KIND=dp) :: alat(3), cut, cut2, rlc1i, rlc2i, rlc3i, &
4400 44 : rxyz0(3, Nmol), xhalf, yhalf, zhalf
4401 22 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: rel, rxyz
4402 :
4403 22 : xhalf = 0.5_dp*xbox
4404 22 : yhalf = 0.5_dp*ybox
4405 22 : zhalf = 0.5_dp*zbox
4406 :
4407 22 : nat = Nmol
4408 :
4409 22 : alat(1) = xbox
4410 22 : alat(2) = ybox
4411 22 : alat(3) = zbox
4412 :
4413 22022 : DO iat = 1, nat
4414 22000 : jat = 3*(iat - 1)
4415 22000 : rxyz0(1, iat) = R(jat + 1)
4416 22000 : rxyz0(2, iat) = R(jat + 2)
4417 22022 : rxyz0(3, iat) = R(jat + 3)
4418 : END DO
4419 :
4420 22 : cut = R2(2, 2) - 1.d-9
4421 :
4422 : ! linear scaling calculation of verlet list
4423 22 : ll1 = INT(alat(1)/cut)
4424 22 : IF (ll1 < 1) CPABORT("alat(1) too small")
4425 22 : ll2 = INT(alat(2)/cut)
4426 22 : IF (ll2 < 1) CPABORT("alat(2) too small")
4427 22 : ll3 = INT(alat(3)/cut)
4428 22 : IF (ll3 < 1) CPABORT("alat(3) too small")
4429 :
4430 : ! determine number of threadsi (this version is only singlethreaded)
4431 22 : npr = 1
4432 : ! linear scaling calculation of verlet list
4433 :
4434 22 : ncx = 8
4435 : DO
4436 22 : ncx = ncx*2
4437 132 : ALLOCATE (icell(0:ncx, -1:ll1, -1:ll2, -1:ll3))
4438 24442 : icell(0, :, :, :) = 0
4439 22 : rlc1i = ll1/alat(1)
4440 22 : rlc2i = ll2/alat(2)
4441 22 : rlc3i = ll3/alat(3)
4442 :
4443 22022 : DO iat = 1, nat
4444 22000 : l1 = INT(rxyz0(1, iat)*rlc1i)
4445 22000 : l2 = INT(rxyz0(2, iat)*rlc2i)
4446 22000 : l3 = INT(rxyz0(3, iat)*rlc3i)
4447 :
4448 22000 : ii = icell(0, l1, l2, l3)
4449 22000 : ii = ii + 1
4450 22000 : icell(0, l1, l2, l3) = ii
4451 22000 : IF (ii > ncx) THEN
4452 0 : DEALLOCATE (icell)
4453 0 : EXIT
4454 : END IF
4455 22022 : icell(ii, l1, l2, l3) = iat
4456 : END DO
4457 22 : IF (ALLOCATED(icell)) EXIT
4458 : END DO
4459 :
4460 : ! duplicate all atoms within boundary layer
4461 22 : laymx = ncx*(2*ll1*ll2 + 2*ll1*ll3 + 2*ll2*ll3 + 4*ll1 + 4*ll2 + 4*ll3 + 8)
4462 22 : nn = nat + laymx
4463 110 : ALLOCATE (rxyz(3, nn), lay(nn))
4464 22022 : DO iat = 1, nat
4465 22000 : lay(iat) = iat
4466 22000 : rxyz(1, iat) = rxyz0(1, iat)
4467 22000 : rxyz(2, iat) = rxyz0(2, iat)
4468 22022 : rxyz(3, iat) = rxyz0(3, iat)
4469 : END DO
4470 22 : il = nat
4471 : ! xy plane
4472 198 : DO l2 = 0, ll2 - 1
4473 1606 : DO l1 = 0, ll1 - 1
4474 :
4475 1408 : in = icell(0, l1, l2, 0)
4476 1408 : icell(0, l1, l2, ll3) = in
4477 4128 : DO ii = 1, in
4478 2720 : i = icell(ii, l1, l2, 0)
4479 2720 : il = il + 1
4480 2720 : IF (il > nn) CPABORT("enlarge laymx")
4481 2720 : lay(il) = i
4482 2720 : icell(ii, l1, l2, ll3) = il
4483 2720 : rxyz(1, il) = rxyz(1, i)
4484 2720 : rxyz(2, il) = rxyz(2, i)
4485 4128 : rxyz(3, il) = rxyz(3, i) + alat(3)
4486 : END DO
4487 :
4488 1408 : in = icell(0, l1, l2, ll3 - 1)
4489 1408 : icell(0, l1, l2, -1) = in
4490 4364 : DO ii = 1, in
4491 2780 : i = icell(ii, l1, l2, ll3 - 1)
4492 2780 : il = il + 1
4493 2780 : IF (il > nn) CPABORT("enlarge laymx")
4494 2780 : lay(il) = i
4495 2780 : icell(ii, l1, l2, -1) = il
4496 2780 : rxyz(1, il) = rxyz(1, i)
4497 2780 : rxyz(2, il) = rxyz(2, i)
4498 4188 : rxyz(3, il) = rxyz(3, i) - alat(3)
4499 : END DO
4500 :
4501 : END DO
4502 : END DO
4503 :
4504 : ! yz plane
4505 198 : DO l3 = 0, ll3 - 1
4506 1606 : DO l2 = 0, ll2 - 1
4507 :
4508 1408 : in = icell(0, 0, l2, l3)
4509 1408 : icell(0, ll1, l2, l3) = in
4510 4194 : DO ii = 1, in
4511 2786 : i = icell(ii, 0, l2, l3)
4512 2786 : il = il + 1
4513 2786 : IF (il > nn) CPABORT("enlarge laymx")
4514 2786 : lay(il) = i
4515 2786 : icell(ii, ll1, l2, l3) = il
4516 2786 : rxyz(1, il) = rxyz(1, i) + alat(1)
4517 2786 : rxyz(2, il) = rxyz(2, i)
4518 4194 : rxyz(3, il) = rxyz(3, i)
4519 : END DO
4520 :
4521 1408 : in = icell(0, ll1 - 1, l2, l3)
4522 1408 : icell(0, -1, l2, l3) = in
4523 4298 : DO ii = 1, in
4524 2714 : i = icell(ii, ll1 - 1, l2, l3)
4525 2714 : il = il + 1
4526 2714 : IF (il > nn) CPABORT("enlarge laymx")
4527 2714 : lay(il) = i
4528 2714 : icell(ii, -1, l2, l3) = il
4529 2714 : rxyz(1, il) = rxyz(1, i) - alat(1)
4530 2714 : rxyz(2, il) = rxyz(2, i)
4531 4122 : rxyz(3, il) = rxyz(3, i)
4532 : END DO
4533 :
4534 : END DO
4535 : END DO
4536 :
4537 : ! xz plane
4538 198 : DO l3 = 0, ll3 - 1
4539 1606 : DO l1 = 0, ll1 - 1
4540 :
4541 1408 : in = icell(0, l1, 0, l3)
4542 1408 : icell(0, l1, ll2, l3) = in
4543 4264 : DO ii = 1, in
4544 2856 : i = icell(ii, l1, 0, l3)
4545 2856 : il = il + 1
4546 2856 : IF (il > nn) CPABORT("enlarge laymx")
4547 2856 : lay(il) = i
4548 2856 : icell(ii, l1, ll2, l3) = il
4549 2856 : rxyz(1, il) = rxyz(1, i)
4550 2856 : rxyz(2, il) = rxyz(2, i) + alat(2)
4551 4264 : rxyz(3, il) = rxyz(3, i)
4552 : END DO
4553 :
4554 1408 : in = icell(0, l1, ll2 - 1, l3)
4555 1408 : icell(0, l1, -1, l3) = in
4556 4228 : DO ii = 1, in
4557 2644 : i = icell(ii, l1, ll2 - 1, l3)
4558 2644 : il = il + 1
4559 2644 : IF (il > nn) CPABORT("enlarge laymx")
4560 2644 : lay(il) = i
4561 2644 : icell(ii, l1, -1, l3) = il
4562 2644 : rxyz(1, il) = rxyz(1, i)
4563 2644 : rxyz(2, il) = rxyz(2, i) - alat(2)
4564 4052 : rxyz(3, il) = rxyz(3, i)
4565 : END DO
4566 :
4567 : END DO
4568 : END DO
4569 :
4570 : ! x axis
4571 198 : DO l1 = 0, ll1 - 1
4572 :
4573 176 : in = icell(0, l1, 0, 0)
4574 176 : icell(0, l1, ll2, ll3) = in
4575 564 : DO ii = 1, in
4576 388 : i = icell(ii, l1, 0, 0)
4577 388 : il = il + 1
4578 388 : IF (il > nn) CPABORT("enlarge laymx")
4579 388 : lay(il) = i
4580 388 : icell(ii, l1, ll2, ll3) = il
4581 388 : rxyz(1, il) = rxyz(1, i)
4582 388 : rxyz(2, il) = rxyz(2, i) + alat(2)
4583 564 : rxyz(3, il) = rxyz(3, i) + alat(3)
4584 : END DO
4585 :
4586 176 : in = icell(0, l1, 0, ll3 - 1)
4587 176 : icell(0, l1, ll2, -1) = in
4588 486 : DO ii = 1, in
4589 310 : i = icell(ii, l1, 0, ll3 - 1)
4590 310 : il = il + 1
4591 310 : IF (il > nn) CPABORT("enlarge laymx")
4592 310 : lay(il) = i
4593 310 : icell(ii, l1, ll2, -1) = il
4594 310 : rxyz(1, il) = rxyz(1, i)
4595 310 : rxyz(2, il) = rxyz(2, i) + alat(2)
4596 486 : rxyz(3, il) = rxyz(3, i) - alat(3)
4597 : END DO
4598 :
4599 176 : in = icell(0, l1, ll2 - 1, 0)
4600 176 : icell(0, l1, -1, ll3) = in
4601 468 : DO ii = 1, in
4602 292 : i = icell(ii, l1, ll2 - 1, 0)
4603 292 : il = il + 1
4604 292 : IF (il > nn) CPABORT("enlarge laymx")
4605 292 : lay(il) = i
4606 292 : icell(ii, l1, -1, ll3) = il
4607 292 : rxyz(1, il) = rxyz(1, i)
4608 292 : rxyz(2, il) = rxyz(2, i) - alat(2)
4609 468 : rxyz(3, il) = rxyz(3, i) + alat(3)
4610 : END DO
4611 :
4612 176 : in = icell(0, l1, ll2 - 1, ll3 - 1)
4613 176 : icell(0, l1, -1, -1) = in
4614 638 : DO ii = 1, in
4615 440 : i = icell(ii, l1, ll2 - 1, ll3 - 1)
4616 440 : il = il + 1
4617 440 : IF (il > nn) CPABORT("enlarge laymx")
4618 440 : lay(il) = i
4619 440 : icell(ii, l1, -1, -1) = il
4620 440 : rxyz(1, il) = rxyz(1, i)
4621 440 : rxyz(2, il) = rxyz(2, i) - alat(2)
4622 616 : rxyz(3, il) = rxyz(3, i) - alat(3)
4623 : END DO
4624 :
4625 : END DO
4626 :
4627 : ! y axis
4628 198 : DO l2 = 0, ll2 - 1
4629 :
4630 176 : in = icell(0, 0, l2, 0)
4631 176 : icell(0, ll1, l2, ll3) = in
4632 546 : DO ii = 1, in
4633 370 : i = icell(ii, 0, l2, 0)
4634 370 : il = il + 1
4635 370 : IF (il > nn) CPABORT("enlarge laymx")
4636 370 : lay(il) = i
4637 370 : icell(ii, ll1, l2, ll3) = il
4638 370 : rxyz(1, il) = rxyz(1, i) + alat(1)
4639 370 : rxyz(2, il) = rxyz(2, i)
4640 546 : rxyz(3, il) = rxyz(3, i) + alat(3)
4641 : END DO
4642 :
4643 176 : in = icell(0, 0, l2, ll3 - 1)
4644 176 : icell(0, ll1, l2, -1) = in
4645 546 : DO ii = 1, in
4646 370 : i = icell(ii, 0, l2, ll3 - 1)
4647 370 : il = il + 1
4648 370 : IF (il > nn) CPABORT("enlarge laymx")
4649 370 : lay(il) = i
4650 370 : icell(ii, ll1, l2, -1) = il
4651 370 : rxyz(1, il) = rxyz(1, i) + alat(1)
4652 370 : rxyz(2, il) = rxyz(2, i)
4653 546 : rxyz(3, il) = rxyz(3, i) - alat(3)
4654 : END DO
4655 :
4656 176 : in = icell(0, ll1 - 1, l2, 0)
4657 176 : icell(0, -1, l2, ll3) = in
4658 546 : DO ii = 1, in
4659 370 : i = icell(ii, ll1 - 1, l2, 0)
4660 370 : il = il + 1
4661 370 : IF (il > nn) CPABORT("enlarge laymx")
4662 370 : lay(il) = i
4663 370 : icell(ii, -1, l2, ll3) = il
4664 370 : rxyz(1, il) = rxyz(1, i) - alat(1)
4665 370 : rxyz(2, il) = rxyz(2, i)
4666 546 : rxyz(3, il) = rxyz(3, i) + alat(3)
4667 : END DO
4668 :
4669 176 : in = icell(0, ll1 - 1, l2, ll3 - 1)
4670 176 : icell(0, -1, l2, -1) = in
4671 518 : DO ii = 1, in
4672 320 : i = icell(ii, ll1 - 1, l2, ll3 - 1)
4673 320 : il = il + 1
4674 320 : IF (il > nn) CPABORT("enlarge laymx")
4675 320 : lay(il) = i
4676 320 : icell(ii, -1, l2, -1) = il
4677 320 : rxyz(1, il) = rxyz(1, i) - alat(1)
4678 320 : rxyz(2, il) = rxyz(2, i)
4679 496 : rxyz(3, il) = rxyz(3, i) - alat(3)
4680 : END DO
4681 :
4682 : END DO
4683 :
4684 : ! z axis
4685 198 : DO l3 = 0, ll3 - 1
4686 :
4687 176 : in = icell(0, 0, 0, l3)
4688 176 : icell(0, ll1, ll2, l3) = in
4689 558 : DO ii = 1, in
4690 382 : i = icell(ii, 0, 0, l3)
4691 382 : il = il + 1
4692 382 : IF (il > nn) CPABORT("enlarge laymx")
4693 382 : lay(il) = i
4694 382 : icell(ii, ll1, ll2, l3) = il
4695 382 : rxyz(1, il) = rxyz(1, i) + alat(1)
4696 382 : rxyz(2, il) = rxyz(2, i) + alat(2)
4697 558 : rxyz(3, il) = rxyz(3, i)
4698 : END DO
4699 :
4700 176 : in = icell(0, ll1 - 1, 0, l3)
4701 176 : icell(0, -1, ll2, l3) = in
4702 546 : DO ii = 1, in
4703 370 : i = icell(ii, ll1 - 1, 0, l3)
4704 370 : il = il + 1
4705 370 : IF (il > nn) CPABORT("enlarge laymx")
4706 370 : lay(il) = i
4707 370 : icell(ii, -1, ll2, l3) = il
4708 370 : rxyz(1, il) = rxyz(1, i) - alat(1)
4709 370 : rxyz(2, il) = rxyz(2, i) + alat(2)
4710 546 : rxyz(3, il) = rxyz(3, i)
4711 : END DO
4712 :
4713 176 : in = icell(0, 0, ll2 - 1, l3)
4714 176 : icell(0, ll1, -1, l3) = in
4715 520 : DO ii = 1, in
4716 344 : i = icell(ii, 0, ll2 - 1, l3)
4717 344 : il = il + 1
4718 344 : IF (il > nn) CPABORT("enlarge laymx")
4719 344 : lay(il) = i
4720 344 : icell(ii, ll1, -1, l3) = il
4721 344 : rxyz(1, il) = rxyz(1, i) + alat(1)
4722 344 : rxyz(2, il) = rxyz(2, i) - alat(2)
4723 520 : rxyz(3, il) = rxyz(3, i)
4724 : END DO
4725 :
4726 176 : in = icell(0, ll1 - 1, ll2 - 1, l3)
4727 176 : icell(0, -1, -1, l3) = in
4728 532 : DO ii = 1, in
4729 334 : i = icell(ii, ll1 - 1, ll2 - 1, l3)
4730 334 : il = il + 1
4731 334 : IF (il > nn) CPABORT("enlarge laymx")
4732 334 : lay(il) = i
4733 334 : icell(ii, -1, -1, l3) = il
4734 334 : rxyz(1, il) = rxyz(1, i) - alat(1)
4735 334 : rxyz(2, il) = rxyz(2, i) - alat(2)
4736 510 : rxyz(3, il) = rxyz(3, i)
4737 : END DO
4738 :
4739 : END DO
4740 :
4741 : ! corners
4742 22 : in = icell(0, 0, 0, 0)
4743 22 : icell(0, ll1, ll2, ll3) = in
4744 92 : DO ii = 1, in
4745 70 : i = icell(ii, 0, 0, 0)
4746 70 : il = il + 1
4747 70 : IF (il > nn) CPABORT("enlarge laymx")
4748 70 : lay(il) = i
4749 70 : icell(ii, ll1, ll2, ll3) = il
4750 70 : rxyz(1, il) = rxyz(1, i) + alat(1)
4751 70 : rxyz(2, il) = rxyz(2, i) + alat(2)
4752 92 : rxyz(3, il) = rxyz(3, i) + alat(3)
4753 : END DO
4754 :
4755 22 : in = icell(0, ll1 - 1, 0, 0)
4756 22 : icell(0, -1, ll2, ll3) = in
4757 46 : DO ii = 1, in
4758 24 : i = icell(ii, ll1 - 1, 0, 0)
4759 24 : il = il + 1
4760 24 : IF (il > nn) CPABORT("enlarge laymx")
4761 24 : lay(il) = i
4762 24 : icell(ii, -1, ll2, ll3) = il
4763 24 : rxyz(1, il) = rxyz(1, i) - alat(1)
4764 24 : rxyz(2, il) = rxyz(2, i) + alat(2)
4765 46 : rxyz(3, il) = rxyz(3, i) + alat(3)
4766 : END DO
4767 :
4768 22 : in = icell(0, 0, ll2 - 1, 0)
4769 22 : icell(0, ll1, -1, ll3) = in
4770 66 : DO ii = 1, in
4771 44 : i = icell(ii, 0, ll2 - 1, 0)
4772 44 : il = il + 1
4773 44 : IF (il > nn) CPABORT("enlarge laymx")
4774 44 : lay(il) = i
4775 44 : icell(ii, ll1, -1, ll3) = il
4776 44 : rxyz(1, il) = rxyz(1, i) + alat(1)
4777 44 : rxyz(2, il) = rxyz(2, i) - alat(2)
4778 66 : rxyz(3, il) = rxyz(3, i) + alat(3)
4779 : END DO
4780 :
4781 22 : in = icell(0, ll1 - 1, ll2 - 1, 0)
4782 22 : icell(0, -1, -1, ll3) = in
4783 86 : DO ii = 1, in
4784 64 : i = icell(ii, ll1 - 1, ll2 - 1, 0)
4785 64 : il = il + 1
4786 64 : IF (il > nn) CPABORT("enlarge laymx")
4787 64 : lay(il) = i
4788 64 : icell(ii, -1, -1, ll3) = il
4789 64 : rxyz(1, il) = rxyz(1, i) - alat(1)
4790 64 : rxyz(2, il) = rxyz(2, i) - alat(2)
4791 86 : rxyz(3, il) = rxyz(3, i) + alat(3)
4792 : END DO
4793 :
4794 22 : in = icell(0, 0, 0, ll3 - 1)
4795 22 : icell(0, ll1, ll2, -1) = in
4796 66 : DO ii = 1, in
4797 44 : i = icell(ii, 0, 0, ll3 - 1)
4798 44 : il = il + 1
4799 44 : IF (il > nn) CPABORT("enlarge laymx")
4800 44 : lay(il) = i
4801 44 : icell(ii, ll1, ll2, -1) = il
4802 44 : rxyz(1, il) = rxyz(1, i) + alat(1)
4803 44 : rxyz(2, il) = rxyz(2, i) + alat(2)
4804 66 : rxyz(3, il) = rxyz(3, i) - alat(3)
4805 : END DO
4806 :
4807 22 : in = icell(0, ll1 - 1, 0, ll3 - 1)
4808 22 : icell(0, -1, ll2, -1) = in
4809 46 : DO ii = 1, in
4810 24 : i = icell(ii, ll1 - 1, 0, ll3 - 1)
4811 24 : il = il + 1
4812 24 : IF (il > nn) CPABORT("enlarge laymx")
4813 24 : lay(il) = i
4814 24 : icell(ii, -1, ll2, -1) = il
4815 24 : rxyz(1, il) = rxyz(1, i) - alat(1)
4816 24 : rxyz(2, il) = rxyz(2, i) + alat(2)
4817 46 : rxyz(3, il) = rxyz(3, i) - alat(3)
4818 : END DO
4819 :
4820 22 : in = icell(0, 0, ll2 - 1, ll3 - 1)
4821 22 : icell(0, ll1, -1, -1) = in
4822 86 : DO ii = 1, in
4823 64 : i = icell(ii, 0, ll2 - 1, ll3 - 1)
4824 64 : il = il + 1
4825 64 : IF (il > nn) CPABORT("enlarge laymx")
4826 64 : lay(il) = i
4827 64 : icell(ii, ll1, -1, -1) = il
4828 64 : rxyz(1, il) = rxyz(1, i) + alat(1)
4829 64 : rxyz(2, il) = rxyz(2, i) - alat(2)
4830 86 : rxyz(3, il) = rxyz(3, i) - alat(3)
4831 : END DO
4832 :
4833 22 : in = icell(0, ll1 - 1, ll2 - 1, ll3 - 1)
4834 22 : icell(0, -1, -1, -1) = in
4835 62 : DO ii = 1, in
4836 40 : i = icell(ii, ll1 - 1, ll2 - 1, ll3 - 1)
4837 40 : il = il + 1
4838 40 : IF (il > nn) CPABORT("enlarge laymx")
4839 40 : lay(il) = i
4840 40 : icell(ii, -1, -1, -1) = il
4841 40 : rxyz(1, il) = rxyz(1, i) - alat(1)
4842 40 : rxyz(2, il) = rxyz(2, i) - alat(2)
4843 62 : rxyz(3, il) = rxyz(3, i) - alat(3)
4844 : END DO
4845 :
4846 22 : nnbrx = 3*nnbrx/2
4847 66 : ALLOCATE (rel(5, nnbrx*nat))
4848 22 : indlstx = 0
4849 :
4850 22 : npr = 1
4851 22 : iam = 0
4852 :
4853 22 : cut2 = cut**2
4854 : ! assign contiguous portions of the arrays lstb and rel to the threads
4855 22 : myspace = (nat*nnbrx)/npr
4856 : IF (iam == 0) myspaceout = myspace
4857 : ! Verlet list, relative positions
4858 22 : indlst = 0
4859 198 : DO l3 = 0, ll3 - 1
4860 1606 : DO l2 = 0, ll2 - 1
4861 12848 : DO l1 = 0, ll1 - 1
4862 34672 : DO ii = 1, icell(0, l1, l2, l3)
4863 22000 : iat = icell(ii, l1, l2, l3)
4864 33264 : IF (((iat - 1)*npr)/nat == iam) THEN
4865 : ! write(6,*) 'sublstiat:iam,iat',iam,iat
4866 22000 : lsta(1, iat) = iam*myspace + indlst + 1
4867 : CALL tersoff_sublstiat_l(iat, nn, ncx, ll1, ll2, ll3, l1, l2, l3, myspace, &
4868 22000 : rxyz, icell, lstb(iam*myspace + 1), lay, rel(1, iam*myspace + 1), cut2, indlst)
4869 22000 : lsta(2, iat) = iam*myspace + indlst
4870 22000 : ipb = lsta(1, iat)
4871 22000 : ndat = lsta(2, iat) - lsta(1, iat) + 1
4872 : END IF
4873 :
4874 : END DO
4875 : END DO
4876 : END DO
4877 : END DO
4878 22 : indlstx = MAX(indlstx, indlst)
4879 :
4880 22 : IF (indlstx >= myspaceout) CPABORT("NNBRX too small")
4881 22 : npr = 1
4882 22 : iam = 0
4883 :
4884 22 : npjx = 300; npjkx = 6000
4885 22 : istopg = 0
4886 : !end of creating pairlist part------------------------------------------------------------
4887 : !Energy-----------------------------------------------------------------------------------
4888 22 : Urtot = 0.0_dp
4889 22 : Nptot = 0
4890 :
4891 66022 : F = 0.0_dp
4892 22 : Uatot = 0.0_dp
4893 22022 : DO_I: DO i = 1, Nmol
4894 22022 : CALL tersoff_subeniat_l(i, Nmol, Npmax, Kinds, X, R1, R2, Cr, Ca, alr, ala, XYZRrefdf, UadUrdf, Urtot, lsta, lstb, nnbrx, rel)
4895 : END DO DO_I
4896 :
4897 22 : Urtot = 0.5_dp*Urtot
4898 : !Force------------------------------------------------------------------------------------
4899 66022 : F = 0.0_dp
4900 : Uatot = 0.0_dp
4901 :
4902 22022 : DO_If: DO i = 1, Nmol
4903 22022 : CALL tersoff_subfiat_l(i,Nmol,Npmax,NNmax,Kinds,Pn,Co_bcd,bcsq,dsq,h,XYZRrefdf,UadUrdf,F,Uatot,dkEij,lsta,lstb,nnbrx)
4904 : END DO DO_If
4905 :
4906 66022 : F = 0.5_dp*F
4907 22 : Uatot = 0.5_dp*Uatot
4908 : !-----------------------------------------------------------------------------------------
4909 22 : DEALLOCATE (rxyz, icell, lay, rel)
4910 22 : END SUBROUTINE tersoff_pairlist_energy_forces
4911 :
4912 : !-----------------------------------------------------------------------------------------
4913 : ! **************************************************************************************************
4914 : !> \brief ...
4915 : !> \param iat ...
4916 : !> \param nn ...
4917 : !> \param ncx ...
4918 : !> \param ll1 ...
4919 : !> \param ll2 ...
4920 : !> \param ll3 ...
4921 : !> \param l1 ...
4922 : !> \param l2 ...
4923 : !> \param l3 ...
4924 : !> \param myspace ...
4925 : !> \param rxyz ...
4926 : !> \param icell ...
4927 : !> \param lstb ...
4928 : !> \param lay ...
4929 : !> \param rel ...
4930 : !> \param cut2 ...
4931 : !> \param indlst ...
4932 : ! **************************************************************************************************
4933 22000 : SUBROUTINE tersoff_sublstiat_l(iat, nn, ncx, ll1, ll2, ll3, l1, l2, l3, myspace, &
4934 22000 : rxyz, icell, lstb, lay, rel, cut2, indlst)
4935 : ! finds the neighbours of atom iat (specified by lsta and lstb) and and
4936 : ! the relative position rel of iat with respect to these neighbours
4937 : INTEGER :: iat, nn, ncx, ll1, ll2, ll3, l1, l2, l3, &
4938 : myspace
4939 : REAL(KIND=dp) :: rxyz(3, nn)
4940 : INTEGER :: icell(0:ncx, -1:ll1, -1:ll2, -1:ll3), lstb(0:myspace - 1), lay(nn)
4941 : REAL(KIND=dp) :: rel(5, 0:myspace - 1), cut2
4942 : INTEGER :: indlst
4943 :
4944 : INTEGER :: jat, jj, k1, k2, k3
4945 : REAL(KIND=dp) :: rr2, tt, tti, xrel, yrel, zrel
4946 :
4947 88000 : DO k3 = l3 - 1, l3 + 1
4948 286000 : DO k2 = l2 - 1, l2 + 1
4949 858000 : DO k1 = l1 - 1, l1 + 1
4950 1949100 : DO jj = 1, icell(0, k1, k2, k3)
4951 1157100 : jat = icell(jj, k1, k2, k3)
4952 1157100 : IF (jat == iat) CYCLE
4953 1135100 : xrel = rxyz(1, iat) - rxyz(1, jat)
4954 1135100 : yrel = rxyz(2, iat) - rxyz(2, jat)
4955 1135100 : zrel = rxyz(3, iat) - rxyz(3, jat)
4956 1135100 : rr2 = xrel**2 + yrel**2 + zrel**2
4957 1729100 : IF (rr2 <= cut2) THEN
4958 88000 : indlst = MIN(indlst, myspace - 1)
4959 88000 : lstb(indlst) = lay(jat)
4960 : ! write(6,*) 'iat,indlst,lay(jat)',iat,indlst,lay(jat)
4961 88000 : tt = SQRT(rr2)
4962 88000 : tti = 1._dp/tt
4963 88000 : rel(1, indlst) = xrel*tti
4964 88000 : rel(2, indlst) = yrel*tti
4965 88000 : rel(3, indlst) = zrel*tti
4966 88000 : rel(4, indlst) = tt
4967 88000 : rel(5, indlst) = tti
4968 88000 : indlst = indlst + 1
4969 : END IF
4970 : END DO
4971 : END DO
4972 : END DO
4973 : END DO
4974 :
4975 22000 : RETURN
4976 : END SUBROUTINE tersoff_sublstiat_l
4977 :
4978 : ! **************************************************************************************************
4979 : !> \brief ...
4980 : !> \param i ...
4981 : !> \param Nmol ...
4982 : !> \param Npmax ...
4983 : !> \param Kinds ...
4984 : !> \param X ...
4985 : !> \param R1 ...
4986 : !> \param R2 ...
4987 : !> \param Cr ...
4988 : !> \param Ca ...
4989 : !> \param alr ...
4990 : !> \param ala ...
4991 : !> \param XYZRrefdf ...
4992 : !> \param UadUrdf ...
4993 : !> \param Urtot ...
4994 : !> \param lsta ...
4995 : !> \param lstb ...
4996 : !> \param nnbrx ...
4997 : !> \param rel ...
4998 : ! **************************************************************************************************
4999 22000 : SUBROUTINE tersoff_subeniat_l(i, Nmol, Npmax, Kinds, X, R1, R2, Cr, Ca, alr, ala, XYZRrefdf, UadUrdf, Urtot, lsta, lstb, nnbrx, rel)
5000 : INTEGER :: i
5001 : INTEGER, INTENT(in) :: Nmol, Npmax
5002 : INTEGER, DIMENSION(1:Nmol), INTENT(in) :: Kinds
5003 : REAL(KIND=dp), DIMENSION(1:2, 1:2), INTENT(in) :: X, R1, R2, Cr, Ca, alr, ala
5004 : REAL(KIND=dp), DIMENSION(1:6*Npmax), INTENT(inout) :: XYZRrefdf
5005 : REAL(KIND=dp), DIMENSION(1:3*Npmax), INTENT(inout) :: UadUrdf
5006 : REAL(KIND=dp), INTENT(inout) :: Urtot
5007 : INTEGER, INTENT(in) :: lsta(2, Nmol), nnbrx, lstb(nnbrx*Nmol)
5008 : REAL(KIND=dp), INTENT(in) :: rel(5, nnbrx*Nmol)
5009 :
5010 : INTEGER :: j, Ki, Kj, l, Nppt3, Nppt6, Nptot
5011 : REAL(KIND=dp) :: alaij, alrij, dfij, fij, PL1, PL2, R1ij, &
5012 : R2ij, Rij, Rreij, Ua, Ur, Xij, Yij, Zij
5013 :
5014 : ! #######################################
5015 : ! # Calculate XYZRrefdf, UadUrdf, Urtot #
5016 : ! #######################################
5017 22000 : Ki = Kinds(i)
5018 :
5019 110000 : DO_J: DO l = lsta(1, i), lsta(2, i)
5020 88000 : j = lstb(l)
5021 :
5022 88000 : Kj = Kinds(j)
5023 88000 : R2ij = R2(Ki, Kj)
5024 88000 : Rij = rel(4, l)
5025 88000 : Xij = rel(1, l)
5026 88000 : Yij = rel(2, l)
5027 88000 : Zij = rel(3, l)
5028 88000 : Nptot = l
5029 :
5030 88000 : Nppt3 = 3*(Nptot - 1)
5031 88000 : Nppt6 = 6*(Nptot - 1)
5032 88000 : Rreij = rel(5, l)
5033 :
5034 88000 : XYZRrefdf(Nppt6 + 1) = Xij
5035 88000 : XYZRrefdf(Nppt6 + 2) = Yij
5036 88000 : XYZRrefdf(Nppt6 + 3) = Zij
5037 88000 : XYZRrefdf(Nppt6 + 4) = Rreij
5038 :
5039 88000 : alrij = alr(Ki, Kj)
5040 88000 : alaij = ala(Ki, Kj)
5041 :
5042 88000 : Ur = Cr(Ki, Kj)*EXP(-alrij*Rij)
5043 88000 : Ua = -Ca(Ki, Kj)*EXP(-alaij*Rij)*X(Ki, Kj)
5044 88000 : R1ij = R1(Ki, Kj)
5045 :
5046 110000 : IF (Rij <= R1ij) THEN
5047 88000 : XYZRrefdf(Nppt6 + 5) = 1.0_dp
5048 88000 : XYZRrefdf(Nppt6 + 6) = 0.0_dp
5049 88000 : Urtot = Urtot + Ur
5050 88000 : UadUrdf(Nppt3 + 1) = Ua
5051 88000 : UadUrdf(Nppt3 + 2) = -alrij*Ur
5052 88000 : UadUrdf(Nppt3 + 3) = -alaij*Ua
5053 : ELSE
5054 0 : PL1 = pi/(R2ij - R1ij)
5055 0 : PL2 = PL1*(Rij - R1ij)
5056 0 : fij = 0.5_dp + 0.5_dp*COS(PL2)
5057 0 : dfij = -0.5_dp*PL1*SIN(PL2)
5058 0 : XYZRrefdf(Nppt6 + 5) = fij
5059 0 : XYZRrefdf(Nppt6 + 6) = dfij
5060 0 : Urtot = Urtot + fij*Ur
5061 0 : UadUrdf(Nppt3 + 1) = fij*Ua
5062 0 : UadUrdf(Nppt3 + 2) = (dfij - alrij*fij)*Ur
5063 0 : UadUrdf(Nppt3 + 3) = (dfij - alaij*fij)*Ua
5064 : END IF
5065 : END DO DO_J
5066 22000 : END SUBROUTINE tersoff_subeniat_l
5067 :
5068 : ! **************************************************************************************************
5069 : !> \brief ...
5070 : !> \param i ...
5071 : !> \param Nmol ...
5072 : !> \param Npmax ...
5073 : !> \param NNmax ...
5074 : !> \param Kinds ...
5075 : !> \param Pn ...
5076 : !> \param Co_bcd ...
5077 : !> \param bcsq ...
5078 : !> \param dsq ...
5079 : !> \param h ...
5080 : !> \param XYZRrefdf ...
5081 : !> \param UadUrdf ...
5082 : !> \param F ...
5083 : !> \param Uatot ...
5084 : !> \param dkEij ...
5085 : !> \param lsta ...
5086 : !> \param lstb ...
5087 : !> \param nnbrx ...
5088 : ! **************************************************************************************************
5089 22000 : SUBROUTINE tersoff_subfiat_l(i,Nmol,Npmax,NNmax,Kinds,Pn,Co_bcd,bcsq,dsq,h,XYZRrefdf,UadUrdf,F,Uatot,dkEij,lsta,lstb,nnbrx)
5090 : INTEGER :: i
5091 : INTEGER, INTENT(in) :: Nmol, Npmax, NNmax
5092 : INTEGER, DIMENSION(1:Nmol), INTENT(in) :: Kinds
5093 : REAL(KIND=dp), DIMENSION(1:2), INTENT(in) :: Pn, Co_bcd, bcsq, dsq, h
5094 : REAL(KIND=dp), DIMENSION(1:6*Npmax), INTENT(in) :: XYZRrefdf
5095 : REAL(KIND=dp), DIMENSION(1:3*Npmax), INTENT(in) :: UadUrdf
5096 : REAL(KIND=dp), DIMENSION(1:3*Nmol), INTENT(inout) :: F
5097 : REAL(KIND=dp), INTENT(inout) :: Uatot
5098 : REAL(KIND=dp), DIMENSION(1:3*NNmax) :: dkEij
5099 : INTEGER, INTENT(in) :: lsta(2, Nmol), nnbrx, lstb(nnbrx*Nmol)
5100 :
5101 : INTEGER :: ij, ijpt3, ijpt6, ik, ikpt6, Ipb, Ipe, &
5102 : Ipt3, Jpt3, Ki, Kpt3, Nkpt3
5103 : REAL(KIND=dp) :: bcsqi, Bij, Co1_dkEij, Co2_dkEij, Co_cdi, Co_dhcosi, Co_hcosi, Co_mb1, &
5104 : Co_mb2, Co_pa, COSijk, dfij, dfik, dFxi, dFxj, dFxk, dFyi, dFyj, dFyk, dFzi, dFzj, dFzk, &
5105 : dGi, djEij, dsqi, dXjEij2, dYjEij2, dZjEij2, Eij, fdG, fdGcos, fij, fik, Gi, hi, Pni, &
5106 : Rreij, Rreik, Ua, XRreij, XRreik, YRreij, YRreik, ZRreij, ZRreik
5107 :
5108 22000 : Ipb = lsta(1, i)
5109 22000 : Ipe = lsta(2, i)
5110 :
5111 22000 : Ki = Kinds(i)
5112 22000 : bcsqi = bcsq(Ki)
5113 22000 : dsqi = dsq(Ki)
5114 22000 : hi = h(Ki)
5115 22000 : Pni = Pn(Ki)
5116 :
5117 22000 : Co_cdi = Co_bcd(Ki)
5118 :
5119 22000 : dFxi = 0.0_dp
5120 22000 : dFyi = 0.0_dp
5121 22000 : dFzi = 0.0_dp
5122 :
5123 110000 : DO_J: DO ij = Ipb, Ipe, +1
5124 :
5125 88000 : IJpt3 = 3*(ij - 1)
5126 88000 : IJpt6 = 6*(ij - 1)
5127 :
5128 88000 : XRreij = XYZRrefdf(IJpt6 + 1)
5129 88000 : YRreij = XYZRrefdf(IJpt6 + 2)
5130 88000 : ZRreij = XYZRrefdf(IJpt6 + 3)
5131 88000 : Rreij = XYZRrefdf(IJpt6 + 4)
5132 88000 : fij = XYZRrefdf(IJpt6 + 5)
5133 88000 : dfij = XYZRrefdf(IJpt6 + 6)
5134 :
5135 88000 : Eij = 0.0_dp
5136 88000 : djEij = 0.0_dp
5137 88000 : dXjEij2 = 0.0_dp
5138 88000 : dYjEij2 = 0.0_dp
5139 88000 : dZjEij2 = 0.0_dp
5140 :
5141 88000 : Nkpt3 = -3
5142 440000 : DO_K: DO ik = Ipb, Ipe, +1
5143 :
5144 352000 : Nkpt3 = Nkpt3 + 3
5145 :
5146 440000 : IKIJ: IF (ik /= ij) THEN
5147 :
5148 264000 : IKpt6 = 6*(ik - 1)
5149 :
5150 264000 : XRreik = XYZRrefdf(IKpt6 + 1)
5151 264000 : YRreik = XYZRrefdf(IKpt6 + 2)
5152 264000 : ZRreik = XYZRrefdf(IKpt6 + 3)
5153 264000 : Rreik = XYZRrefdf(IKpt6 + 4)
5154 264000 : fik = XYZRrefdf(IKpt6 + 5)
5155 264000 : dfik = XYZRrefdf(IKpt6 + 6)
5156 :
5157 264000 : COSijk = XRreij*XRreik + YRreij*YRreik + ZRreij*ZRreik
5158 :
5159 264000 : Co_hcosi = hi - COSijk
5160 264000 : Co_dhcosi = 1.0_dp/(dsqi + Co_hcosi*Co_hcosi)
5161 264000 : Gi = -bcsqi*Co_dhcosi
5162 264000 : dGi = 2.0_dp*Co_hcosi*Co_dhcosi*Gi
5163 264000 : Gi = Gi + Co_cdi
5164 :
5165 264000 : Eij = Eij + fik*Gi
5166 :
5167 264000 : fdG = fik*dGi
5168 264000 : fdGcos = fdG*COSijk
5169 :
5170 264000 : djEij = djEij + fdGcos
5171 :
5172 264000 : dXjEij2 = dXjEij2 + fdG*XRreik
5173 264000 : dYjEij2 = dYjEij2 + fdG*YRreik
5174 264000 : dZjEij2 = dZjEij2 + fdG*ZRreik
5175 :
5176 264000 : Co1_dkEij = -dfik*Gi + fdGcos*Rreik
5177 264000 : Co2_dkEij = -fdG*Rreik
5178 :
5179 264000 : dkEij(Nkpt3 + 1) = Co1_dkEij*XRreik + Co2_dkEij*XRreij
5180 264000 : dkEij(Nkpt3 + 2) = Co1_dkEij*YRreik + Co2_dkEij*YRreij
5181 264000 : dkEij(Nkpt3 + 3) = Co1_dkEij*ZRreik + Co2_dkEij*ZRreij
5182 :
5183 : ELSE
5184 88000 : dkEij(Nkpt3 + 1) = 0.0_dp
5185 88000 : dkEij(Nkpt3 + 2) = 0.0_dp
5186 88000 : dkEij(Nkpt3 + 3) = 0.0_dp
5187 : END IF IKIJ
5188 :
5189 : END DO DO_K
5190 :
5191 88000 : Bij = 1.0_dp + Eij**Pni
5192 88000 : Ua = UadUrdf(IJpt3 + 1)*Bij**(-0.5_dp/Pni)
5193 88000 : Uatot = Uatot + Ua
5194 :
5195 88000 : Co_pa = UadUrdf(IJpt3 + 2) + UadUrdf(IJpt3 + 3)*Bij**(-0.5_dp/Pni)
5196 :
5197 88000 : CEij: IF (Nkpt3 > 0) THEN
5198 :
5199 88000 : Co_mb1 = Ua*0.5_dp*Eij**(Pni - 1.0_dp)/Bij
5200 88000 : Co_mb2 = Co_mb1*Rreij
5201 :
5202 88000 : Nkpt3 = -3
5203 440000 : DO ik = Ipb, Ipe, +1
5204 :
5205 352000 : Nkpt3 = Nkpt3 + 3
5206 352000 : dFxk = Co_mb1*dkEij(Nkpt3 + 1)
5207 352000 : dFyk = Co_mb1*dkEij(Nkpt3 + 2)
5208 352000 : dFzk = Co_mb1*dkEij(Nkpt3 + 3)
5209 :
5210 352000 : Kpt3 = 3*(lstb(ik) - 1)
5211 352000 : F(Kpt3 + 1) = F(Kpt3 + 1) + dFxk
5212 352000 : F(Kpt3 + 2) = F(Kpt3 + 2) + dFyk
5213 352000 : F(Kpt3 + 3) = F(Kpt3 + 3) + dFzk
5214 :
5215 352000 : dFxi = dFxi + dFxk
5216 352000 : dFyi = dFyi + dFyk
5217 440000 : dFzi = dFzi + dFzk
5218 :
5219 : END DO
5220 :
5221 88000 : dFxj = Co_pa*XRreij + Co_mb2*(XRreij*djEij - dXjEij2)
5222 88000 : dFyj = Co_pa*YRreij + Co_mb2*(YRreij*djEij - dYjEij2)
5223 88000 : dFzj = Co_pa*ZRreij + Co_mb2*(ZRreij*djEij - dZjEij2)
5224 :
5225 : ELSE
5226 :
5227 0 : dFxj = Co_pa*XRreij
5228 0 : dFyj = Co_pa*YRreij
5229 0 : dFzj = Co_pa*ZRreij
5230 :
5231 : END IF CEij
5232 :
5233 88000 : Jpt3 = 3*(lstb(ij) - 1)
5234 :
5235 88000 : F(Jpt3 + 1) = F(Jpt3 + 1) + dFxj
5236 88000 : F(Jpt3 + 2) = F(Jpt3 + 2) + dFyj
5237 88000 : F(Jpt3 + 3) = F(Jpt3 + 3) + dFzj
5238 :
5239 88000 : dFxi = dFxi + dFxj
5240 88000 : dFyi = dFyi + dFyj
5241 110000 : dFzi = dFzi + dFzj
5242 :
5243 : END DO DO_J
5244 :
5245 22000 : Ipt3 = 3*(i - 1)
5246 22000 : F(Ipt3 + 1) = F(Ipt3 + 1) - dFxi
5247 22000 : F(Ipt3 + 2) = F(Ipt3 + 2) - dFyi
5248 22000 : F(Ipt3 + 3) = F(Ipt3 + 3) - dFzi
5249 22000 : END SUBROUTINE tersoff_subfiat_l
5250 :
5251 : END MODULE eip_silicon
|
