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