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