(git:0761fd1)
Loading...
Searching...
No Matches
pair_potential_types.F
Go to the documentation of this file.
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!> \par History
10!> Teodoro Laino [Teo] 11.2005 : Reorganizing the structures to optimize
11!> memory management
12!> \author CJM
13! **************************************************************************************************
15
17 USE kinds, ONLY: default_path_length,&
19 dp
27#include "./base/base_uses.f90"
28
29 IMPLICIT NONE
30
31 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'pair_potential_types'
32
33 PRIVATE
34 ! when adding a new nonbonded potential please update also the list_pot
35 ! used for the linear scaling screening of potential calculation
36 INTEGER, PUBLIC, PARAMETER :: multi_type = -1, &
37 nn_type = 0, &
38 lj_type = 1, &
39 lj_charmm_type = 2, &
40 ft_type = 3, &
41 wl_type = 4, &
42 gw_type = 5, &
43 ip_type = 6, &
44 ea_type = 7, &
45 b4_type = 8, &
46 bm_type = 9, &
47 gp_type = 10, &
48 tersoff_type = 11, &
49 ftd_type = 12, &
50 siepmann_type = 13, &
51 gal_type = 14, &
52 nequip_type = 16, &
53 allegro_type = 17, &
54 gal21_type = 18, &
55 tab_type = 19, &
56 deepmd_type = 20, &
57 ace_type = 21, &
58 mace_type = 22
59
60 INTEGER, PUBLIC, PARAMETER, DIMENSION(22) :: list_pot = [nn_type, &
61 lj_type, &
63 ft_type, &
64 wl_type, &
65 gw_type, &
66 ip_type, &
67 ea_type, &
68 b4_type, &
69 bm_type, &
70 gp_type, &
72 ftd_type, &
74 gal_type, &
77 gal21_type, &
78 tab_type, &
80 ace_type, &
82
83 ! Shell model
84 INTEGER, PUBLIC, PARAMETER :: nosh_nosh = 0, &
85 nosh_sh = 1, &
86 sh_sh = 2
87
88 INTEGER, PUBLIC, PARAMETER, DIMENSION(3) :: list_sh_type = [nosh_nosh, nosh_sh, sh_sh]
89
90 ! Single Spline generation info
91 REAL(kind=dp), PARAMETER, PUBLIC :: not_initialized = -huge(0.0_dp)
92 INTEGER, PARAMETER, DIMENSION(2), PUBLIC :: do_potential_single_allocation = [lj_type, lj_charmm_type]
93 INTEGER, PARAMETER, DIMENSION(2), PUBLIC :: no_potential_single_allocation = [-huge(0), -huge(0)]
94 INTEGER, DIMENSION(2), PUBLIC :: potential_single_allocation
95
97
102
103 PUBLIC :: pair_potential_pp_create, &
106
107 PUBLIC :: pair_potential_p_type, &
109
110 PUBLIC :: ft_pot_type, &
112 eam_pot_type, &
115 ace_pot_type, &
118 gal_pot_type, &
121
123 PUBLIC :: compare_pot
124
125! **************************************************************************************************
127 REAL(kind=dp), DIMENSION(2:15) :: a = 0.0_dp
128 REAL(kind=dp) :: rcore = 0.0_dp
129 REAL(kind=dp) :: m = 0.0_dp
130 REAL(kind=dp) :: b = 0.0_dp
131 END TYPE ipbv_pot_type
132
133! **************************************************************************************************
134 TYPE lj_pot_type
135 REAL(kind=dp) :: epsilon = 0.0_dp
136 REAL(kind=dp) :: sigma6 = 0.0_dp
137 REAL(kind=dp) :: sigma12 = 0.0_dp
138 END TYPE lj_pot_type
139
140! **************************************************************************************************
142 REAL(kind=dp) :: a = 0.0_dp
143 REAL(kind=dp) :: b = 0.0_dp
144 REAL(kind=dp) :: c = 0.0_dp
145 REAL(kind=dp) :: d = 0.0_dp
146 END TYPE ft_pot_type
147
148! **************************************************************************************************
149 TYPE ftd_pot_type
150 REAL(kind=dp) :: a = 0.0_dp
151 REAL(kind=dp) :: b = 0.0_dp
152 REAL(kind=dp) :: c = 0.0_dp
153 REAL(kind=dp) :: d = 0.0_dp
154 REAL(kind=dp), DIMENSION(2) :: bd = 0.0_dp
155 END TYPE ftd_pot_type
156
157! **************************************************************************************************
158 TYPE williams_pot_type
159 REAL(kind=dp) :: a = 0.0_dp
160 REAL(kind=dp) :: b = 0.0_dp
161 REAL(kind=dp) :: c = 0.0_dp
162 END TYPE williams_pot_type
163
164! **************************************************************************************************
165 TYPE goodwin_pot_type
166 REAL(kind=dp) :: vr0 = 0.0_dp
167 REAL(kind=dp) :: m = 0.0_dp, mc = 0.0_dp
168 REAL(kind=dp) :: d = 0.0_dp, dc = 0.0_dp
169 END TYPE goodwin_pot_type
170
171! **************************************************************************************************
173 CHARACTER(LEN=default_path_length) :: eam_file_name = ""
174 INTEGER :: npoints = 0
175 REAL(kind=dp) :: drar = 0.0_dp, drhoar = 0.0_dp, acutal = 0.0_dp
176 REAL(kind=dp), POINTER, DIMENSION(:) :: rho => null(), phi => null(), frho => null(), rhoval => null(), rval => null()
177 REAL(kind=dp), POINTER, DIMENSION(:) :: rhop => null(), phip => null(), frhop => null()
178 END TYPE eam_pot_type
179
180! **************************************************************************************************
182 CHARACTER(LEN=default_path_length) :: ace_file_name = 'NULL'
183 INTEGER :: atom_ace_type = 0
185 END TYPE ace_pot_type
186
187! **************************************************************************************************
189 CHARACTER(LEN=default_path_length) :: deepmd_file_name = 'NULL'
190 INTEGER :: atom_deepmd_type = 0
191 END TYPE deepmd_pot_type
192
193! **************************************************************************************************
195 CHARACTER(LEN=default_path_length) :: pot_file_name = 'NULL', &
196 unit_length = 'NULL', unit_forces = 'NULL', &
197 unit_energy = 'NULL'
198 CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: type_names_torch
199 REAL(kind=dp), DIMENSION(:, :), ALLOCATABLE :: cutoff_matrix
200 INTEGER :: num_types = 0
201 REAL(kind=dp) :: rcutsq = 0.0_dp, unit_length_val = 1.0_dp, &
202 unit_forces_val = 1.0_dp, unit_energy_val = 1.0_dp
203 LOGICAL :: mixed_precision = .false.
204 END TYPE nequip_pot_type
205
206! **************************************************************************************************
207 TYPE buck4ran_pot_type
208 REAL(kind=dp) :: a = 0.0_dp
209 REAL(kind=dp) :: b = 0.0_dp
210 REAL(kind=dp) :: c = 0.0_dp
211 REAL(kind=dp) :: r1 = 0.0_dp
212 REAL(kind=dp) :: r2 = 0.0_dp
213 REAL(kind=dp) :: r3 = 0.0_dp
214 INTEGER :: npoly1 = 0, npoly2 = 0
215 REAL(kind=dp), DIMENSION(0:10) :: poly1 = 0.0_dp
216 REAL(kind=dp), DIMENSION(0:10) :: poly2 = 0.0_dp
217 END TYPE buck4ran_pot_type
218
219! **************************************************************************************************
220 TYPE buckmorse_pot_type
221 REAL(kind=dp) :: f0 = 0.0_dp
222 REAL(kind=dp) :: a1 = 0.0_dp
223 REAL(kind=dp) :: a2 = 0.0_dp
224 REAL(kind=dp) :: b1 = 0.0_dp
225 REAL(kind=dp) :: b2 = 0.0_dp
226 REAL(kind=dp) :: c = 0.0_dp
227 REAL(kind=dp) :: d = 0.0_dp
228 REAL(kind=dp) :: r0 = 0.0_dp
229 REAL(kind=dp) :: beta = 0.0_dp
230 END TYPE buckmorse_pot_type
231
232! **************************************************************************************************
233 TYPE gp_pot_type
234 INTEGER :: myid = 0
235 CHARACTER(LEN=default_path_length) :: potential = ""
236 CHARACTER(LEN=default_string_length), &
237 ALLOCATABLE, DIMENSION(:) :: parameters
238 CHARACTER(LEN=default_string_length) :: variables = ""
239 REAL(kind=dp), DIMENSION(:), ALLOCATABLE :: values
240 END TYPE gp_pot_type
241
242! **************************************************************************************************
244 ! Get this stuff from the PRB V38, N14 9902 (1988) by Tersoff
245 REAL(kind=dp) :: a = 0.0_dp
246 REAL(kind=dp) :: b = 0.0_dp
247 REAL(kind=dp) :: lambda1 = 0.0_dp
248 REAL(kind=dp) :: lambda2 = 0.0_dp
249 REAL(kind=dp) :: alpha = 0.0_dp
250 REAL(kind=dp) :: beta = 0.0_dp
251 REAL(kind=dp) :: n = 0.0_dp
252 REAL(kind=dp) :: c = 0.0_dp
253 REAL(kind=dp) :: d = 0.0_dp
254 REAL(kind=dp) :: h = 0.0_dp
255 REAL(kind=dp) :: lambda3 = 0.0_dp
256 REAL(kind=dp) :: bigr = 0.0_dp ! Used to be R = Rij + D
257 REAL(kind=dp) :: bigd = 0.0_dp ! Used to be D = Rij - D
258 REAL(kind=dp) :: rcutsq = 0.0_dp ! Always set to (bigR+bigD)^2
259 END TYPE tersoff_pot_type
260
261! **************************************************************************************************
263 REAL(kind=dp) :: b = 0.0_dp
264 REAL(kind=dp) :: d = 0.0_dp
265 REAL(kind=dp) :: e = 0.0_dp
266 REAL(kind=dp) :: f = 0.0_dp
267 REAL(kind=dp) :: beta = 0.0_dp
268 REAL(kind=dp) :: rcutsq = 0.0_dp
269 LOGICAL :: allow_oh_formation = .false.
270 LOGICAL :: allow_h3o_formation = .false.
271 LOGICAL :: allow_o_formation = .false.
272 END TYPE siepmann_pot_type
273
274! **************************************************************************************************
276 CHARACTER(LEN=2) :: met1 = ""
277 CHARACTER(LEN=2) :: met2 = ""
278 REAL(kind=dp) :: epsilon = 0.0_dp
279 REAL(kind=dp) :: bxy = 0.0_dp
280 REAL(kind=dp) :: bz = 0.0_dp
281 REAL(kind=dp) :: r1 = 0.0_dp
282 REAL(kind=dp) :: r2 = 0.0_dp
283 REAL(kind=dp) :: a1 = 0.0_dp
284 REAL(kind=dp) :: a2 = 0.0_dp
285 REAL(kind=dp) :: a3 = 0.0_dp
286 REAL(kind=dp) :: a4 = 0.0_dp
287 REAL(kind=dp) :: a = 0.0_dp
288 REAL(kind=dp) :: b = 0.0_dp
289 REAL(kind=dp) :: c = 0.0_dp
290 REAL(kind=dp), POINTER, DIMENSION(:) :: gcn => null()
291 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :) :: n_vectors
292 REAL(kind=dp) :: rcutsq = 0.0_dp
293 LOGICAL :: express = .false.
294 END TYPE gal_pot_type
295
296! **************************************************************************************************
297
299 CHARACTER(LEN=2) :: met1 = ""
300 CHARACTER(LEN=2) :: met2 = ""
301 REAL(kind=dp) :: epsilon1 = 0.0_dp
302 REAL(kind=dp) :: epsilon2 = 0.0_dp
303 REAL(kind=dp) :: epsilon3 = 0.0_dp
304 REAL(kind=dp) :: bxy1 = 0.0_dp
305 REAL(kind=dp) :: bxy2 = 0.0_dp
306 REAL(kind=dp) :: bz1 = 0.0_dp
307 REAL(kind=dp) :: bz2 = 0.0_dp
308 REAL(kind=dp) :: r1 = 0.0_dp
309 REAL(kind=dp) :: r2 = 0.0_dp
310 REAL(kind=dp) :: a11 = 0.0_dp
311 REAL(kind=dp) :: a12 = 0.0_dp
312 REAL(kind=dp) :: a13 = 0.0_dp
313 REAL(kind=dp) :: a21 = 0.0_dp
314 REAL(kind=dp) :: a22 = 0.0_dp
315 REAL(kind=dp) :: a23 = 0.0_dp
316 REAL(kind=dp) :: a31 = 0.0_dp
317 REAL(kind=dp) :: a32 = 0.0_dp
318 REAL(kind=dp) :: a33 = 0.0_dp
319 REAL(kind=dp) :: a41 = 0.0_dp
320 REAL(kind=dp) :: a42 = 0.0_dp
321 REAL(kind=dp) :: a43 = 0.0_dp
322 REAL(kind=dp) :: ao1 = 0.0_dp
323 REAL(kind=dp) :: ao2 = 0.0_dp
324 REAL(kind=dp) :: bo1 = 0.0_dp
325 REAL(kind=dp) :: bo2 = 0.0_dp
326 REAL(kind=dp) :: c = 0.0_dp
327 REAL(kind=dp) :: ah1 = 0.0_dp
328 REAL(kind=dp) :: ah2 = 0.0_dp
329 REAL(kind=dp) :: bh1 = 0.0_dp
330 REAL(kind=dp) :: bh2 = 0.0_dp
331 REAL(kind=dp), POINTER, DIMENSION(:) :: gcn => null()
332 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :) :: n_vectors
333 REAL(kind=dp) :: rcutsq = 0.0_dp
334 LOGICAL :: express = .false.
335 END TYPE gal21_pot_type
336
337! **************************************************************************************************
338
340 CHARACTER(LEN=default_path_length) :: tabpot_file_name = ""
341 INTEGER :: npoints = 0, index = 0
342 REAL(kind=dp) :: dr = 0.0_dp, rcut = 0.0_dp
343 REAL(kind=dp), POINTER, DIMENSION(:) :: r => null(), e => null(), f => null()
344 END TYPE tab_pot_type
345
346! **************************************************************************************************
347
348 TYPE pot_set_type
349 REAL(kind=dp) :: rmin = 0.0_dp, rmax = 0.0_dp
350 TYPE(ipbv_pot_type), POINTER :: ipbv => null()
351 TYPE(gp_pot_type), POINTER :: gp => null()
352 TYPE(lj_pot_type), POINTER :: lj => null()
353 TYPE(ft_pot_type), POINTER :: ft => null()
354 TYPE(williams_pot_type), POINTER :: willis => null()
355 TYPE(goodwin_pot_type), POINTER :: goodwin => null()
356 TYPE(eam_pot_type), POINTER :: eam => null()
357 TYPE(nequip_pot_type), POINTER :: nequip => null()
358 TYPE(ace_pot_type), POINTER :: ace => null()
359 TYPE(deepmd_pot_type), POINTER :: deepmd => null()
360 TYPE(buck4ran_pot_type), POINTER :: buck4r => null()
361 TYPE(buckmorse_pot_type), POINTER :: buckmo => null()
362 TYPE(tersoff_pot_type), POINTER :: tersoff => null()
363 TYPE(siepmann_pot_type), POINTER :: siepmann => null()
364 TYPE(gal_pot_type), POINTER :: gal => null()
365 TYPE(gal21_pot_type), POINTER :: gal21 => null()
366 TYPE(ftd_pot_type), POINTER :: ftd => null()
367 TYPE(tab_pot_type), POINTER :: tab => null()
368 END TYPE pot_set_type
369
370! **************************************************************************************************
372 REAL(kind=dp) :: rcutsq = 0.0_dp
373 REAL(kind=dp) :: e_fac = 0.0_dp
374 REAL(kind=dp) :: e_fcc = 0.0_dp
375 REAL(kind=dp) :: e_fcs = 0.0_dp
376 REAL(kind=dp) :: e_fsc = 0.0_dp
377 REAL(kind=dp) :: z1 = 0.0_dp
378 REAL(kind=dp) :: z2 = 0.0_dp
379 REAL(kind=dp), DIMENSION(0:5) :: zbl_poly = 0.0_dp
380 REAL(kind=dp), DIMENSION(2) :: zbl_rcut = 0.0_dp
381 LOGICAL :: undef = .false., & ! non-bonding interaction not defined
382 no_mb = .false., & ! no many-body potential
383 no_pp = .false. ! no pair (=two-body) potential
384 INTEGER :: shell_type = 0
385 CHARACTER(LEN=default_string_length) :: at1 = ""
386 CHARACTER(LEN=default_string_length) :: at2 = ""
387 INTEGER, POINTER, DIMENSION(:) :: TYPE => null()
388 TYPE(pot_set_type), POINTER, DIMENSION(:) :: set => null()
389 TYPE(spline_data_p_type), POINTER, DIMENSION(:) :: pair_spline_data => null()
390 TYPE(spline_factor_type), POINTER :: spl_f => null()
392
393! **************************************************************************************************
394 TYPE pair_potential_type
395 TYPE(pair_potential_single_type), POINTER :: pot => null()
396 END TYPE pair_potential_type
397
398! **************************************************************************************************
400 TYPE(pair_potential_type), DIMENSION(:), POINTER :: pot => null()
401 END TYPE pair_potential_p_type
402
403! **************************************************************************************************
405 TYPE(pair_potential_type), DIMENSION(:, :), POINTER :: pot => null()
407
408CONTAINS
409
410! **************************************************************************************************
411!> \brief compare two different potentials
412!> \param pot1 ...
413!> \param pot2 ...
414!> \param compare ...
415!> \author Teodoro Laino [teo] 05.2006
416! **************************************************************************************************
417 SUBROUTINE compare_pot(pot1, pot2, compare)
418 TYPE(pair_potential_single_type), POINTER :: pot1, pot2
419 LOGICAL, INTENT(OUT) :: compare
420
421 INTEGER :: i
422 LOGICAL :: mycompare
423
424 compare = .false.
425 ! Preliminary checks
426
427 cpassert(ASSOCIATED(pot1%type))
428 cpassert(ASSOCIATED(pot2%type))
429 IF (SIZE(pot1%type) /= SIZE(pot2%type)) RETURN
430 IF (any(pot1%type /= pot2%type)) RETURN
431
432 ! Checking the real values of parameters
433 cpassert(ASSOCIATED(pot1%set))
434 cpassert(ASSOCIATED(pot2%set))
435 DO i = 1, SIZE(pot1%type)
436 mycompare = .false.
437 SELECT CASE (pot1%type(i))
438 CASE (lj_type, lj_charmm_type)
439 IF ((pot1%set(i)%lj%epsilon == pot2%set(i)%lj%epsilon) .AND. &
440 (pot1%set(i)%lj%sigma6 == pot2%set(i)%lj%sigma6) .AND. &
441 (pot1%set(i)%lj%sigma12 == pot2%set(i)%lj%sigma12)) mycompare = .true.
442 CASE (wl_type)
443 IF ((pot1%set(i)%willis%a == pot2%set(i)%willis%a) .AND. &
444 (pot1%set(i)%willis%b == pot2%set(i)%willis%b) .AND. &
445 (pot1%set(i)%willis%c == pot2%set(i)%willis%c)) mycompare = .true.
446 CASE (gw_type)
447 IF ((pot1%set(i)%goodwin%vr0 == pot2%set(i)%goodwin%vr0) .AND. &
448 (pot1%set(i)%goodwin%m == pot2%set(i)%goodwin%m) .AND. &
449 (pot1%set(i)%goodwin%mc == pot2%set(i)%goodwin%mc) .AND. &
450 (pot1%set(i)%goodwin%d == pot2%set(i)%goodwin%d) .AND. &
451 (pot1%set(i)%goodwin%dc == pot2%set(i)%goodwin%dc)) mycompare = .true.
452 CASE (ea_type)
453 ! Compare only if EAM have the same number of points
454 IF (pot1%set(i)%eam%npoints == pot2%set(i)%eam%npoints) THEN
455 IF ((pot1%set(i)%eam%drar == pot2%set(i)%eam%drar) .AND. &
456 (pot1%set(i)%eam%drhoar == pot2%set(i)%eam%drhoar) .AND. &
457 (pot1%set(i)%eam%acutal == pot2%set(i)%eam%acutal) .AND. &
458 (sum(abs(pot1%set(i)%eam%rho - pot2%set(i)%eam%rho)) == 0.0_dp) .AND. &
459 (sum(abs(pot1%set(i)%eam%phi - pot2%set(i)%eam%phi)) == 0.0_dp) .AND. &
460 (sum(abs(pot1%set(i)%eam%frho - pot2%set(i)%eam%frho)) == 0.0_dp) .AND. &
461 (sum(abs(pot1%set(i)%eam%rhoval - pot2%set(i)%eam%rhoval)) == 0.0_dp) .AND. &
462 (sum(abs(pot1%set(i)%eam%rval - pot2%set(i)%eam%rval)) == 0.0_dp) .AND. &
463 (sum(abs(pot1%set(i)%eam%rhop - pot2%set(i)%eam%rhop)) == 0.0_dp) .AND. &
464 (sum(abs(pot1%set(i)%eam%phip - pot2%set(i)%eam%phip)) == 0.0_dp) .AND. &
465 (sum(abs(pot1%set(i)%eam%frhop - pot2%set(i)%eam%frhop)) == 0.0_dp)) mycompare = .true.
466 END IF
467 CASE (ace_type)
468 IF ((pot1%set(i)%ace%ace_file_name == pot2%set(i)%ace%ace_file_name) .AND. &
469 (pot1%set(i)%ace%atom_ace_type == pot2%set(i)%ace%atom_ace_type)) mycompare = .true.
470 CASE (deepmd_type)
471 IF ((pot1%set(i)%deepmd%deepmd_file_name == pot2%set(i)%deepmd%deepmd_file_name) .AND. &
472 (pot1%set(i)%deepmd%atom_deepmd_type == pot2%set(i)%deepmd%atom_deepmd_type)) mycompare = .true.
474 IF ((pot1%set(i)%nequip%pot_file_name == pot2%set(i)%nequip%pot_file_name) .AND. &
475 (pot1%set(i)%nequip%unit_length == pot2%set(i)%nequip%unit_length) .AND. &
476 (pot1%set(i)%nequip%unit_forces == pot2%set(i)%nequip%unit_forces) .AND. &
477 (pot1%set(i)%nequip%unit_energy == pot2%set(i)%nequip%unit_energy)) mycompare = .true.
478 CASE (ft_type)
479 IF ((pot1%set(i)%ft%A == pot2%set(i)%ft%A) .AND. &
480 (pot1%set(i)%ft%B == pot2%set(i)%ft%B) .AND. &
481 (pot1%set(i)%ft%C == pot2%set(i)%ft%C) .AND. &
482 (pot1%set(i)%ft%D == pot2%set(i)%ft%D)) mycompare = .true.
483 CASE (ftd_type)
484 IF ((pot1%set(i)%ftd%A == pot2%set(i)%ftd%A) .AND. &
485 (pot1%set(i)%ftd%B == pot2%set(i)%ftd%B) .AND. &
486 (pot1%set(i)%ftd%C == pot2%set(i)%ftd%C) .AND. &
487 (pot1%set(i)%ftd%D == pot2%set(i)%ftd%D) .AND. &
488 (all(pot1%set(i)%ftd%BD(:) == pot2%set(i)%ftd%BD(:)))) mycompare = .true.
489 CASE (ip_type)
490 IF ((sum(abs(pot1%set(i)%ipbv%a - pot2%set(i)%ipbv%a)) == 0.0_dp) .AND. &
491 (pot1%set(i)%ipbv%rcore == pot2%set(i)%ipbv%rcore) .AND. &
492 (pot1%set(i)%ipbv%m == pot2%set(i)%ipbv%m) .AND. &
493 (pot1%set(i)%ipbv%b == pot2%set(i)%ipbv%b)) mycompare = .true.
494 CASE (tersoff_type)
495 IF ((pot1%set(i)%tersoff%A == pot2%set(i)%tersoff%A) .AND. &
496 (pot1%set(i)%tersoff%B == pot2%set(i)%tersoff%B) .AND. &
497 (pot1%set(i)%tersoff%lambda1 == pot2%set(i)%tersoff%lambda1) .AND. &
498 (pot1%set(i)%tersoff%lambda2 == pot2%set(i)%tersoff%lambda2) .AND. &
499 (pot1%set(i)%tersoff%alpha == pot2%set(i)%tersoff%alpha) .AND. &
500 (pot1%set(i)%tersoff%beta == pot2%set(i)%tersoff%beta) .AND. &
501 (pot1%set(i)%tersoff%n == pot2%set(i)%tersoff%n) .AND. &
502 (pot1%set(i)%tersoff%c == pot2%set(i)%tersoff%c) .AND. &
503 (pot1%set(i)%tersoff%d == pot2%set(i)%tersoff%d) .AND. &
504 (pot1%set(i)%tersoff%h == pot2%set(i)%tersoff%h) .AND. &
505 (pot1%set(i)%tersoff%lambda3 == pot2%set(i)%tersoff%lambda3) .AND. &
506 (pot1%set(i)%tersoff%rcutsq == pot2%set(i)%tersoff%rcutsq) .AND. &
507 (pot1%set(i)%tersoff%bigR == pot2%set(i)%tersoff%bigR) .AND. &
508 (pot1%set(i)%tersoff%bigD == pot2%set(i)%tersoff%bigD)) mycompare = .true.
509 CASE (siepmann_type)
510 IF ((pot1%set(i)%siepmann%B == pot2%set(i)%siepmann%B) .AND. &
511 (pot1%set(i)%siepmann%D == pot2%set(i)%siepmann%D) .AND. &
512 (pot1%set(i)%siepmann%E == pot2%set(i)%siepmann%E) .AND. &
513 (pot1%set(i)%siepmann%F == pot2%set(i)%siepmann%F) .AND. &
514 (pot1%set(i)%siepmann%beta == pot2%set(i)%siepmann%beta) .AND. &
515 (pot1%set(i)%siepmann%rcutsq == pot2%set(i)%siepmann%rcutsq) .AND. &
516 (pot1%set(i)%siepmann%allow_oh_formation .EQV. &
517 pot2%set(i)%siepmann%allow_oh_formation) .AND. &
518 (pot1%set(i)%siepmann%allow_o_formation .EQV. &
519 pot2%set(i)%siepmann%allow_o_formation) .AND. &
520 (pot1%set(i)%siepmann%allow_h3o_formation .EQV. &
521 pot2%set(i)%siepmann%allow_h3o_formation)) mycompare = .true.
522 CASE (gal_type)
523 IF ((pot1%set(i)%gal%epsilon == pot2%set(i)%gal%epsilon) .AND. &
524 (pot1%set(i)%gal%bxy == pot2%set(i)%gal%bxy) .AND. &
525 (pot1%set(i)%gal%bz == pot2%set(i)%gal%bz) .AND. &
526 (pot1%set(i)%gal%r1 == pot2%set(i)%gal%r1) .AND. &
527 (pot1%set(i)%gal%r2 == pot2%set(i)%gal%r2) .AND. &
528 (pot1%set(i)%gal%a1 == pot2%set(i)%gal%a1) .AND. &
529 (pot1%set(i)%gal%a2 == pot2%set(i)%gal%a2) .AND. &
530 (pot1%set(i)%gal%a3 == pot2%set(i)%gal%a3) .AND. &
531 (pot1%set(i)%gal%a4 == pot2%set(i)%gal%a4) .AND. &
532 (pot1%set(i)%gal%a == pot2%set(i)%gal%a) .AND. &
533 (pot1%set(i)%gal%b == pot2%set(i)%gal%b) .AND. &
534 (pot1%set(i)%gal%c == pot2%set(i)%gal%c) .AND. &
535 (pot1%set(i)%gal%express .EQV. &
536 pot2%set(i)%gal%express) .AND. &
537 (pot1%set(i)%gal%rcutsq == pot2%set(i)%gal%rcutsq)) mycompare = .true.
538 CASE (gal21_type)
539 IF ((pot1%set(i)%gal21%epsilon1 == pot2%set(i)%gal21%epsilon1) .AND. &
540 (pot1%set(i)%gal21%epsilon2 == pot2%set(i)%gal21%epsilon2) .AND. &
541 (pot1%set(i)%gal21%epsilon3 == pot2%set(i)%gal21%epsilon3) .AND. &
542 (pot1%set(i)%gal21%bxy1 == pot2%set(i)%gal21%bxy1) .AND. &
543 (pot1%set(i)%gal21%bxy2 == pot2%set(i)%gal21%bxy1) .AND. &
544 (pot1%set(i)%gal21%bz1 == pot2%set(i)%gal21%bz1) .AND. &
545 (pot1%set(i)%gal21%bz2 == pot2%set(i)%gal21%bz2) .AND. &
546 (pot1%set(i)%gal21%r1 == pot2%set(i)%gal21%r1) .AND. &
547 (pot1%set(i)%gal21%r2 == pot2%set(i)%gal21%r2) .AND. &
548 (pot1%set(i)%gal21%a11 == pot2%set(i)%gal21%a11) .AND. &
549 (pot1%set(i)%gal21%a12 == pot2%set(i)%gal21%a12) .AND. &
550 (pot1%set(i)%gal21%a13 == pot2%set(i)%gal21%a13) .AND. &
551 (pot1%set(i)%gal21%a21 == pot2%set(i)%gal21%a21) .AND. &
552 (pot1%set(i)%gal21%a22 == pot2%set(i)%gal21%a22) .AND. &
553 (pot1%set(i)%gal21%a23 == pot2%set(i)%gal21%a23) .AND. &
554 (pot1%set(i)%gal21%a31 == pot2%set(i)%gal21%a31) .AND. &
555 (pot1%set(i)%gal21%a32 == pot2%set(i)%gal21%a32) .AND. &
556 (pot1%set(i)%gal21%a33 == pot2%set(i)%gal21%a33) .AND. &
557 (pot1%set(i)%gal21%a41 == pot2%set(i)%gal21%a41) .AND. &
558 (pot1%set(i)%gal21%a42 == pot2%set(i)%gal21%a42) .AND. &
559 (pot1%set(i)%gal21%a43 == pot2%set(i)%gal21%a43) .AND. &
560 (pot1%set(i)%gal21%AO1 == pot2%set(i)%gal21%AO1) .AND. &
561 (pot1%set(i)%gal21%AO2 == pot2%set(i)%gal21%AO2) .AND. &
562 (pot1%set(i)%gal21%BO1 == pot2%set(i)%gal21%BO1) .AND. &
563 (pot1%set(i)%gal21%BO2 == pot2%set(i)%gal21%BO2) .AND. &
564 (pot1%set(i)%gal21%c == pot2%set(i)%gal21%c) .AND. &
565 (pot1%set(i)%gal21%AH1 == pot2%set(i)%gal21%AH1) .AND. &
566 (pot1%set(i)%gal21%AH2 == pot2%set(i)%gal21%AH2) .AND. &
567 (pot1%set(i)%gal21%BH1 == pot2%set(i)%gal21%BH1) .AND. &
568 (pot1%set(i)%gal21%BH2 == pot2%set(i)%gal21%BH2) .AND. &
569 (pot1%set(i)%gal21%express .EQV. &
570 pot2%set(i)%gal21%express) .AND. &
571 (pot1%set(i)%gal21%rcutsq == pot2%set(i)%gal21%rcutsq)) mycompare = .true.
572 CASE (gp_type)
573 ! The original logic in get_nonbond_storage of pair_potential.F checks
574 ! only the parameters and values and returns true unless some different
575 ! value is found; in fact the potential and variables should also be
576 ! checked for matching strings
577 mycompare = .true.
578 IF (ALLOCATED(pot1%set(i)%gp%parameters) .AND. ALLOCATED(pot2%set(i)%gp%parameters)) THEN
579 IF (SIZE(pot1%set(i)%gp%parameters) == SIZE(pot2%set(i)%gp%parameters)) THEN
580 IF (any(pot1%set(i)%gp%parameters /= pot2%set(i)%gp%parameters)) THEN
581 mycompare = .false.
582 END IF
583 END IF
584 END IF
585 IF (ALLOCATED(pot1%set(i)%gp%values) .AND. ALLOCATED(pot2%set(i)%gp%values)) THEN
586 IF (SIZE(pot1%set(i)%gp%values) == SIZE(pot2%set(i)%gp%values)) THEN
587 IF (any(pot1%set(i)%gp%values /= pot2%set(i)%gp%values)) THEN
588 mycompare = .false.
589 END IF
590 END IF
591 END IF
592 END SELECT
593 mycompare = mycompare .AND. &
594 (pot1%set(i)%rmin == pot2%set(i)%rmin) .AND. (pot1%set(i)%rmax == pot2%set(i)%rmax)
595 IF ((mycompare) .AND. (i == 1)) compare = .true.
596 compare = compare .AND. mycompare
597 END DO
598
599 END SUBROUTINE compare_pot
600
601! **************************************************************************************************
602!> \brief Creates the potential parameter type
603!> \param potparm ...
604!> \param nset ...
605!> \author Teodoro Laino [teo] 11.2005
606! **************************************************************************************************
607 SUBROUTINE pair_potential_single_create(potparm, nset)
608 TYPE(pair_potential_single_type), POINTER :: potparm
609 INTEGER, INTENT(IN), OPTIONAL :: nset
610
611 INTEGER :: i, lnset
612
613 cpassert(.NOT. ASSOCIATED(potparm))
614 ALLOCATE (potparm)
615 lnset = 1
616 IF (PRESENT(nset)) lnset = nset
617 ! Standard allocation to size 1
618 ALLOCATE (potparm%type(lnset))
619 ALLOCATE (potparm%set(lnset))
620 NULLIFY (potparm%spl_f, &
621 potparm%pair_spline_data)
622 DO i = 1, lnset
623 potparm%set(i)%rmin = not_initialized
624 potparm%set(i)%rmax = not_initialized
625 NULLIFY (potparm%set(i)%ipbv, &
626 potparm%set(i)%lj, &
627 potparm%set(i)%gp, &
628 potparm%set(i)%ft, &
629 potparm%set(i)%willis, &
630 potparm%set(i)%goodwin, &
631 potparm%set(i)%eam, &
632 potparm%set(i)%nequip, &
633 potparm%set(i)%ace, &
634 potparm%set(i)%deepmd, &
635 potparm%set(i)%buck4r, &
636 potparm%set(i)%buckmo, &
637 potparm%set(i)%tersoff, &
638 potparm%set(i)%siepmann, &
639 potparm%set(i)%gal, &
640 potparm%set(i)%gal21, &
641 potparm%set(i)%ftd, &
642 potparm%set(i)%tab)
643 END DO
644 CALL pair_potential_single_clean(potparm)
645 END SUBROUTINE pair_potential_single_create
646
647! **************************************************************************************************
648!> \brief Cleans the potential parameter type
649!> \param potparm ...
650!> \author unknown
651! **************************************************************************************************
652 SUBROUTINE pair_potential_single_clean(potparm)
653 TYPE(pair_potential_single_type), POINTER :: potparm
654
655 INTEGER :: i
656
657 potparm%type = nn_type
658 potparm%shell_type = nosh_nosh
659 potparm%undef = .true.
660 potparm%no_pp = .false.
661 potparm%no_mb = .false.
662 potparm%at1 = 'NULL'
663 potparm%at2 = 'NULL'
664 potparm%rcutsq = 0.0_dp
665 IF (ASSOCIATED(potparm%pair_spline_data)) THEN
666 CALL spline_data_p_release(potparm%pair_spline_data)
667 END IF
668 IF (ASSOCIATED(potparm%spl_f)) THEN
669 CALL spline_factor_release(potparm%spl_f)
670 END IF
671
672 DO i = 1, SIZE(potparm%type)
673 potparm%set(i)%rmin = not_initialized
674 potparm%set(i)%rmax = not_initialized
675 CALL pair_potential_lj_clean(potparm%set(i)%lj)
676 CALL pair_potential_williams_clean(potparm%set(i)%willis)
677 CALL pair_potential_goodwin_clean(potparm%set(i)%goodwin)
678 CALL pair_potential_eam_clean(potparm%set(i)%eam)
679 CALL pair_potential_nequip_clean(potparm%set(i)%nequip)
680 CALL pair_potential_ace_clean(potparm%set(i)%ace)
681 CALL pair_potential_deepmd_clean(potparm%set(i)%deepmd)
682 CALL pair_potential_buck4r_clean(potparm%set(i)%buck4r)
683 CALL pair_potential_buckmo_clean(potparm%set(i)%buckmo)
684 CALL pair_potential_bmhft_clean(potparm%set(i)%ft)
685 CALL pair_potential_bmhftd_clean(potparm%set(i)%ftd)
686 CALL pair_potential_ipbv_clean(potparm%set(i)%ipbv)
687 CALL pair_potential_gp_clean(potparm%set(i)%gp)
688 CALL pair_potential_tersoff_clean(potparm%set(i)%tersoff)
689 CALL pair_potential_siepmann_clean(potparm%set(i)%siepmann)
690 CALL pair_potential_gal_clean(potparm%set(i)%gal)
691 CALL pair_potential_gal21_clean(potparm%set(i)%gal21)
692 CALL pair_potential_tab_clean(potparm%set(i)%tab)
693 END DO
694 END SUBROUTINE pair_potential_single_clean
695
696! **************************************************************************************************
697!> \brief Copy two potential parameter type
698!> \param potparm_source ...
699!> \param potparm_dest ...
700!> \author Teodoro Laino [teo] 11.2005
701! **************************************************************************************************
702 SUBROUTINE pair_potential_single_copy(potparm_source, potparm_dest)
703 TYPE(pair_potential_single_type), POINTER :: potparm_source, potparm_dest
704
705 INTEGER :: i
706
707 cpassert(ASSOCIATED(potparm_source))
708 IF (.NOT. ASSOCIATED(potparm_dest)) THEN
709 CALL pair_potential_single_create(potparm_dest, SIZE(potparm_source%type))
710 ELSE
711 CALL pair_potential_single_clean(potparm_dest)
712 END IF
713 potparm_dest%type = potparm_source%type
714 potparm_dest%shell_type = potparm_source%shell_type
715 potparm_dest%undef = potparm_source%undef
716 potparm_dest%no_mb = potparm_source%no_mb
717 potparm_dest%no_pp = potparm_source%no_pp
718 potparm_dest%at1 = potparm_source%at1
719 potparm_dest%at2 = potparm_source%at2
720 potparm_dest%rcutsq = potparm_source%rcutsq
721 IF (ASSOCIATED(potparm_source%pair_spline_data)) THEN
722 CALL spline_data_p_copy(potparm_source%pair_spline_data, potparm_dest%pair_spline_data)
723 END IF
724
725 IF (ASSOCIATED(potparm_source%spl_f)) THEN
726 CALL spline_factor_copy(potparm_source%spl_f, potparm_dest%spl_f)
727 END IF
728
729 DO i = 1, SIZE(potparm_source%type)
730 potparm_dest%set(i)%rmin = potparm_source%set(i)%rmin
731 potparm_dest%set(i)%rmax = potparm_source%set(i)%rmax
732 CALL pair_potential_lj_copy(potparm_source%set(i)%lj, potparm_dest%set(i)%lj)
733 CALL pair_potential_williams_copy(potparm_source%set(i)%willis, potparm_dest%set(i)%willis)
734 CALL pair_potential_goodwin_copy(potparm_source%set(i)%goodwin, potparm_dest%set(i)%goodwin)
735 CALL pair_potential_eam_copy(potparm_source%set(i)%eam, potparm_dest%set(i)%eam)
736 CALL pair_potential_nequip_copy(potparm_source%set(i)%nequip, potparm_dest%set(i)%nequip)
737 CALL pair_potential_ace_copy(potparm_source%set(i)%ace, potparm_dest%set(i)%ace)
738 CALL pair_potential_deepmd_copy(potparm_source%set(i)%deepmd, potparm_dest%set(i)%deepmd)
739 CALL pair_potential_bmhft_copy(potparm_source%set(i)%ft, potparm_dest%set(i)%ft)
740 CALL pair_potential_bmhftd_copy(potparm_source%set(i)%ftd, potparm_dest%set(i)%ftd)
741 CALL pair_potential_ipbv_copy(potparm_source%set(i)%ipbv, potparm_dest%set(i)%ipbv)
742 CALL pair_potential_buck4r_copy(potparm_source%set(i)%buck4r, potparm_dest%set(i)%buck4r)
743 CALL pair_potential_buckmo_copy(potparm_source%set(i)%buckmo, potparm_dest%set(i)%buckmo)
744 CALL pair_potential_gp_copy(potparm_source%set(i)%gp, potparm_dest%set(i)%gp)
745 CALL pair_potential_tersoff_copy(potparm_source%set(i)%tersoff, potparm_dest%set(i)%tersoff)
746 CALL pair_potential_siepmann_copy(potparm_source%set(i)%siepmann, potparm_dest%set(i)%siepmann)
747 CALL pair_potential_gal_copy(potparm_source%set(i)%gal, potparm_dest%set(i)%gal)
748 CALL pair_potential_gal21_copy(potparm_source%set(i)%gal21, potparm_dest%set(i)%gal21)
749 CALL pair_potential_tab_copy(potparm_source%set(i)%tab, potparm_dest%set(i)%tab)
750 END DO
751 END SUBROUTINE pair_potential_single_copy
752
753! **************************************************************************************************
754!> \brief Add potential parameter type to an existing potential parameter type
755!> Used in case of multiple_potential definition
756!> \param potparm_source ...
757!> \param potparm_dest ...
758!> \author Teodoro Laino [teo] 11.2005
759! **************************************************************************************************
760 SUBROUTINE pair_potential_single_add(potparm_source, potparm_dest)
761 TYPE(pair_potential_single_type), POINTER :: potparm_source, potparm_dest
762
763 INTEGER :: i, j, size_dest, size_source
764 LOGICAL :: allocate_new, check
765 TYPE(pair_potential_single_type), POINTER :: potparm_tmp
766
767 cpassert(ASSOCIATED(potparm_source))
768 ! At this level we expect all splines types
769 ! be not allocated.. No sense add splines at this level.. in case fail!
770 check = (.NOT. ASSOCIATED(potparm_source%pair_spline_data)) .AND. &
771 (.NOT. ASSOCIATED(potparm_source%spl_f))
772 cpassert(check)
773 check = (.NOT. ASSOCIATED(potparm_dest%pair_spline_data)) .AND. &
774 (.NOT. ASSOCIATED(potparm_dest%spl_f))
775 cpassert(check)
776 ! Increase the size of the destination potparm (in case) and copy the new data
777 size_source = SIZE(potparm_source%type)
778 allocate_new = .NOT. ASSOCIATED(potparm_dest)
779 IF (.NOT. allocate_new) THEN
780 size_dest = SIZE(potparm_dest%type)
781 IF (size_dest == 1) THEN
782 check = (ASSOCIATED(potparm_dest%set(1)%lj)) .OR. &
783 (ASSOCIATED(potparm_dest%set(1)%willis)) .OR. &
784 (ASSOCIATED(potparm_dest%set(1)%goodwin)) .OR. &
785 (ASSOCIATED(potparm_dest%set(1)%eam)) .OR. &
786 (ASSOCIATED(potparm_dest%set(1)%nequip)) .OR. &
787 (ASSOCIATED(potparm_dest%set(1)%ace)) .OR. &
788 (ASSOCIATED(potparm_dest%set(1)%deepmd)) .OR. &
789 (ASSOCIATED(potparm_dest%set(1)%ft)) .OR. &
790 (ASSOCIATED(potparm_dest%set(1)%ftd)) .OR. &
791 (ASSOCIATED(potparm_dest%set(1)%ipbv)) .OR. &
792 (ASSOCIATED(potparm_dest%set(1)%buck4r)) .OR. &
793 (ASSOCIATED(potparm_dest%set(1)%buckmo)) .OR. &
794 (ASSOCIATED(potparm_dest%set(1)%gp)) .OR. &
795 (ASSOCIATED(potparm_dest%set(1)%tersoff)) .OR. &
796 (ASSOCIATED(potparm_dest%set(1)%siepmann)) .OR. &
797 (ASSOCIATED(potparm_dest%set(1)%gal)) .OR. &
798 (ASSOCIATED(potparm_dest%set(1)%gal)) .OR. &
799 (ASSOCIATED(potparm_dest%set(1)%tab))
800 IF (.NOT. check) THEN
801 allocate_new = .true.
802 CALL pair_potential_single_release(potparm_dest)
803 END IF
804 END IF
805 END IF
806 IF (allocate_new) THEN
807 size_dest = 0
808 CALL pair_potential_single_create(potparm_dest, size_source)
809 potparm_dest%shell_type = potparm_source%shell_type
810 potparm_dest%undef = potparm_source%undef
811 potparm_dest%no_mb = potparm_source%no_mb
812 potparm_dest%no_pp = potparm_source%no_pp
813 potparm_dest%at1 = potparm_source%at1
814 potparm_dest%at2 = potparm_source%at2
815 potparm_dest%rcutsq = potparm_source%rcutsq
816 ELSE
817 size_dest = SIZE(potparm_dest%type)
818 NULLIFY (potparm_tmp)
819 CALL pair_potential_single_copy(potparm_dest, potparm_tmp)
820 CALL pair_potential_single_release(potparm_dest)
821 CALL pair_potential_single_create(potparm_dest, size_dest + size_source)
822 ! Copy back original informations..
823 potparm_dest%shell_type = potparm_tmp%shell_type
824 potparm_dest%undef = potparm_tmp%undef
825 potparm_dest%no_mb = potparm_tmp%no_mb
826 potparm_dest%no_pp = potparm_tmp%no_pp
827 potparm_dest%at1 = potparm_tmp%at1
828 potparm_dest%at2 = potparm_tmp%at2
829 potparm_dest%rcutsq = potparm_tmp%rcutsq
830 DO i = 1, size_dest
831 potparm_dest%type(i) = potparm_tmp%type(i)
832 potparm_dest%set(i)%rmin = potparm_tmp%set(i)%rmin
833 potparm_dest%set(i)%rmax = potparm_tmp%set(i)%rmax
834 CALL pair_potential_lj_copy(potparm_tmp%set(i)%lj, potparm_dest%set(i)%lj)
835 CALL pair_potential_williams_copy(potparm_tmp%set(i)%willis, potparm_dest%set(i)%willis)
836 CALL pair_potential_goodwin_copy(potparm_tmp%set(i)%goodwin, potparm_dest%set(i)%goodwin)
837 CALL pair_potential_eam_copy(potparm_tmp%set(i)%eam, potparm_dest%set(i)%eam)
838 CALL pair_potential_nequip_copy(potparm_tmp%set(i)%nequip, potparm_dest%set(i)%nequip)
839 CALL pair_potential_ace_copy(potparm_tmp%set(i)%ace, potparm_dest%set(i)%ace)
840 CALL pair_potential_deepmd_copy(potparm_tmp%set(i)%deepmd, potparm_dest%set(i)%deepmd)
841 CALL pair_potential_bmhft_copy(potparm_tmp%set(i)%ft, potparm_dest%set(i)%ft)
842 CALL pair_potential_bmhftd_copy(potparm_tmp%set(i)%ftd, potparm_dest%set(i)%ftd)
843 CALL pair_potential_ipbv_copy(potparm_tmp%set(i)%ipbv, potparm_dest%set(i)%ipbv)
844 CALL pair_potential_buck4r_copy(potparm_tmp%set(i)%buck4r, potparm_dest%set(i)%buck4r)
845 CALL pair_potential_buckmo_copy(potparm_tmp%set(i)%buckmo, potparm_dest%set(i)%buckmo)
846 CALL pair_potential_gp_copy(potparm_tmp%set(i)%gp, potparm_dest%set(i)%gp)
847 CALL pair_potential_tersoff_copy(potparm_tmp%set(i)%tersoff, potparm_dest%set(i)%tersoff)
848 CALL pair_potential_siepmann_copy(potparm_tmp%set(i)%siepmann, potparm_dest%set(i)%siepmann)
849 CALL pair_potential_gal_copy(potparm_tmp%set(i)%gal, potparm_dest%set(i)%gal)
850 CALL pair_potential_gal21_copy(potparm_tmp%set(i)%gal21, potparm_dest%set(i)%gal21)
851 CALL pair_potential_tab_copy(potparm_tmp%set(i)%tab, potparm_dest%set(i)%tab)
852 END DO
853 CALL pair_potential_single_release(potparm_tmp)
854 END IF
855 ! Further check with main option with source and dest (already filled with few informations)
856 check = (potparm_dest%shell_type == potparm_source%shell_type) .AND. &
857 (potparm_dest%undef .EQV. potparm_source%undef) .AND. &
858 (potparm_dest%no_mb .EQV. potparm_source%no_mb) .AND. &
859 (potparm_dest%no_pp .EQV. potparm_source%no_pp) .AND. &
860 (potparm_dest%at1 == potparm_source%at1) .AND. &
861 (potparm_dest%at2 == potparm_source%at2) .AND. &
862 (potparm_dest%rcutsq == potparm_source%rcutsq)
863 cpassert(check)
864 ! Now copy the new pair_potential type
865 DO i = size_dest + 1, size_dest + size_source
866 j = i - size_dest
867 potparm_dest%type(i) = potparm_source%type(j)
868 potparm_dest%set(i)%rmin = potparm_source%set(j)%rmin
869 potparm_dest%set(i)%rmax = potparm_source%set(j)%rmax
870 CALL pair_potential_lj_copy(potparm_source%set(j)%lj, potparm_dest%set(i)%lj)
871 CALL pair_potential_williams_copy(potparm_source%set(j)%willis, potparm_dest%set(i)%willis)
872 CALL pair_potential_goodwin_copy(potparm_source%set(j)%goodwin, potparm_dest%set(i)%goodwin)
873 CALL pair_potential_eam_copy(potparm_source%set(j)%eam, potparm_dest%set(i)%eam)
874 CALL pair_potential_nequip_copy(potparm_source%set(j)%nequip, potparm_dest%set(i)%nequip)
875 CALL pair_potential_ace_copy(potparm_source%set(j)%ace, potparm_dest%set(i)%ace)
876 CALL pair_potential_deepmd_copy(potparm_source%set(j)%deepmd, potparm_dest%set(i)%deepmd)
877 CALL pair_potential_bmhft_copy(potparm_source%set(j)%ft, potparm_dest%set(i)%ft)
878 CALL pair_potential_bmhftd_copy(potparm_source%set(j)%ftd, potparm_dest%set(i)%ftd)
879 CALL pair_potential_ipbv_copy(potparm_source%set(j)%ipbv, potparm_dest%set(i)%ipbv)
880 CALL pair_potential_buck4r_copy(potparm_source%set(j)%buck4r, potparm_dest%set(i)%buck4r)
881 CALL pair_potential_buckmo_copy(potparm_source%set(j)%buckmo, potparm_dest%set(i)%buckmo)
882 CALL pair_potential_gp_copy(potparm_source%set(j)%gp, potparm_dest%set(i)%gp)
883 CALL pair_potential_tersoff_copy(potparm_source%set(j)%tersoff, potparm_dest%set(i)%tersoff)
884 CALL pair_potential_siepmann_copy(potparm_source%set(j)%siepmann, potparm_dest%set(i)%siepmann)
885 CALL pair_potential_gal_copy(potparm_source%set(j)%gal, potparm_dest%set(i)%gal)
886 CALL pair_potential_gal21_copy(potparm_source%set(j)%gal21, potparm_dest%set(i)%gal21)
887 CALL pair_potential_tab_copy(potparm_source%set(j)%tab, potparm_dest%set(i)%tab)
888 END DO
889 END SUBROUTINE pair_potential_single_add
890
891! **************************************************************************************************
892!> \brief Release Data-structure that constains potential parameters of a single pair
893!> \param potparm ...
894!> \author Teodoro Laino [Teo] 11.2005
895! **************************************************************************************************
896 SUBROUTINE pair_potential_single_release(potparm)
897 TYPE(pair_potential_single_type), POINTER :: potparm
898
899 INTEGER :: i
900
901 cpassert(ASSOCIATED(potparm))
902 CALL spline_data_p_release(potparm%pair_spline_data)
903 CALL spline_factor_release(potparm%spl_f)
904 DO i = 1, SIZE(potparm%type)
905 CALL pair_potential_ipbv_release(potparm%set(i)%ipbv)
906 CALL pair_potential_lj_release(potparm%set(i)%lj)
907 CALL pair_potential_bmhft_release(potparm%set(i)%ft)
908 CALL pair_potential_bmhftd_release(potparm%set(i)%ftd)
909 CALL pair_potential_williams_release(potparm%set(i)%willis)
910 CALL pair_potential_goodwin_release(potparm%set(i)%goodwin)
911 CALL pair_potential_eam_release(potparm%set(i)%eam)
912 CALL pair_potential_nequip_release(potparm%set(i)%nequip)
913 CALL pair_potential_ace_release(potparm%set(i)%ace)
914 CALL pair_potential_deepmd_release(potparm%set(i)%deepmd)
915 CALL pair_potential_buck4r_release(potparm%set(i)%buck4r)
916 CALL pair_potential_buckmo_release(potparm%set(i)%buckmo)
917 CALL pair_potential_gp_release(potparm%set(i)%gp)
918 CALL pair_potential_tersoff_release(potparm%set(i)%tersoff)
919 CALL pair_potential_siepmann_release(potparm%set(i)%siepmann)
920 CALL pair_potential_gal_release(potparm%set(i)%gal)
921 CALL pair_potential_gal21_release(potparm%set(i)%gal21)
922 CALL pair_potential_tab_release(potparm%set(i)%tab)
923 END DO
924 DEALLOCATE (potparm%type)
925 DEALLOCATE (potparm%set)
926 DEALLOCATE (potparm)
927 END SUBROUTINE pair_potential_single_release
928
929! **************************************************************************************************
930!> \brief Data-structure that constains potential parameters
931!> \param potparm ...
932!> \param nkinds ...
933!> \author unknown
934! **************************************************************************************************
935 SUBROUTINE pair_potential_pp_create(potparm, nkinds)
936 TYPE(pair_potential_pp_type), POINTER :: potparm
937 INTEGER, INTENT(IN) :: nkinds
938
939 INTEGER :: i, j
940
941 cpassert(.NOT. ASSOCIATED(potparm))
942 ALLOCATE (potparm)
943 ALLOCATE (potparm%pot(nkinds, nkinds))
944 DO i = 1, nkinds
945 DO j = 1, nkinds
946 NULLIFY (potparm%pot(i, j)%pot)
947 END DO
948 END DO
949 ! Use no-redundancy in the potential definition
950 DO i = 1, nkinds
951 DO j = i, nkinds
952 CALL pair_potential_single_create(potparm%pot(i, j)%pot)
953 potparm%pot(j, i)%pot => potparm%pot(i, j)%pot
954 END DO
955 END DO
956 END SUBROUTINE pair_potential_pp_create
957
958! **************************************************************************************************
959!> \brief Release Data-structure that constains potential parameters
960!> \param potparm ...
961!> \par History
962!> Teodoro Laino [Teo] 11.2005 : Reorganizing the structures to optimize
963!> memory management
964!> \author unknown
965! **************************************************************************************************
966 SUBROUTINE pair_potential_pp_release(potparm)
967 TYPE(pair_potential_pp_type), POINTER :: potparm
968
969 INTEGER :: i, j
970
971 IF (ASSOCIATED(potparm)) THEN
972 IF (ASSOCIATED(potparm%pot)) THEN
973 DO i = 1, SIZE(potparm%pot, 1)
974 DO j = i, SIZE(potparm%pot, 2)
975 CALL pair_potential_single_release(potparm%pot(i, j)%pot)
976 NULLIFY (potparm%pot(j, i)%pot)
977 END DO
978 END DO
979 DEALLOCATE (potparm%pot)
980 END IF
981 DEALLOCATE (potparm)
982 END IF
983 NULLIFY (potparm)
984 END SUBROUTINE pair_potential_pp_release
985
986! **************************************************************************************************
987!> \brief Data-structure that constains potential parameters
988!> \param potparm ...
989!> \param ndim ...
990!> \param ub ...
991!> \param lb ...
992!> \author unknown
993! **************************************************************************************************
994 SUBROUTINE pair_potential_p_create(potparm, ndim, ub, lb)
995 TYPE(pair_potential_p_type), POINTER :: potparm
996 INTEGER, INTENT(IN), OPTIONAL :: ndim, ub, lb
997
998 INTEGER :: i, loc_lb, loc_ub
999
1000 cpassert(.NOT. ASSOCIATED(potparm))
1001 ALLOCATE (potparm)
1002
1003 IF (PRESENT(ndim) .AND. (PRESENT(ub) .OR. PRESENT(lb))) THEN
1004 CALL cp_abort(__location__, &
1005 "pair_potential_p_create expects either 1 input parameter <ndim> "// &
1006 "or 2 input parameters <ub> and <lb> at each call; found <ndim> "// &
1007 "together with <ub> or <lb>")
1008 END IF
1009
1010 IF (PRESENT(ndim)) THEN
1011 loc_lb = 1
1012 loc_ub = ndim
1013 ALLOCATE (potparm%pot(loc_lb:loc_ub))
1014 ELSE IF (PRESENT(lb) .AND. PRESENT(ub)) THEN
1015 loc_lb = lb
1016 loc_ub = ub
1017 ALLOCATE (potparm%pot(loc_lb:loc_ub))
1018 ELSE
1019 CALL cp_abort(__location__, &
1020 "pair_potential_p_create expects either 1 input parameter <ndim> "// &
1021 "or 2 input parameters <ub> and <lb> at each call; found none")
1022 END IF
1023 DO i = loc_lb, loc_ub
1024 NULLIFY (potparm%pot(i)%pot)
1025 CALL pair_potential_single_create(potparm%pot(i)%pot)
1026 END DO
1027 END SUBROUTINE pair_potential_p_create
1028
1029! **************************************************************************************************
1030!> \brief Release Data-structure that constains potential parameters
1031!> \param potparm ...
1032!> \par History
1033!> Teodoro Laino [Teo] 11.2005 : Reorganizing the structures to optimize
1034!> memory management
1035!> \author unknown
1036! **************************************************************************************************
1037 SUBROUTINE pair_potential_p_release(potparm)
1038 TYPE(pair_potential_p_type), POINTER :: potparm
1039
1040 INTEGER :: i
1041
1042 IF (ASSOCIATED(potparm)) THEN
1043 IF (ASSOCIATED(potparm%pot)) THEN
1044 DO i = 1, SIZE(potparm%pot)
1045 CALL pair_potential_single_release(potparm%pot(i)%pot)
1046 END DO
1047 DEALLOCATE (potparm%pot)
1048 END IF
1049 DEALLOCATE (potparm)
1050 END IF
1051 NULLIFY (potparm)
1052 END SUBROUTINE pair_potential_p_release
1053
1054! **************************************************************************************************
1055!> \brief Copy structures between two pair_potential_p_type
1056!> \param source ...
1057!> \param dest ...
1058!> \param istart ...
1059!> \param iend ...
1060!> \author Teodoro Laino [Teo] 11.2005
1061! **************************************************************************************************
1062 SUBROUTINE pair_potential_p_copy(source, dest, istart, iend)
1063 TYPE(pair_potential_p_type), POINTER :: source, dest
1064 INTEGER, INTENT(IN), OPTIONAL :: istart, iend
1065
1066 INTEGER :: i, l_end, l_start
1067
1068 cpassert(ASSOCIATED(source))
1069 cpassert(ASSOCIATED(dest))
1070 l_start = lbound(source%pot, 1)
1071 l_end = ubound(source%pot, 1)
1072 IF (PRESENT(istart)) l_start = istart
1073 IF (PRESENT(iend)) l_end = iend
1074 DO i = l_start, l_end
1075 IF (.NOT. ASSOCIATED(source%pot(i)%pot)) THEN
1076 CALL pair_potential_single_create(source%pot(i)%pot)
1077 END IF
1078 CALL pair_potential_single_copy(source%pot(i)%pot, dest%pot(i)%pot)
1079 END DO
1080 END SUBROUTINE pair_potential_p_copy
1081
1082! **************************************************************************************************
1083!> \brief Cleans the potential parameter type
1084!> \param p ...
1085!> \param lb1_new ...
1086!> \param ub1_new ...
1087!> \param lj ...
1088!> \param lj_charmm ...
1089!> \param williams ...
1090!> \param goodwin ...
1091!> \param eam ...
1092!> \param nequip ...
1093!> \param bmhft ...
1094!> \param bmhftd ...
1095!> \param ipbv ...
1096!> \param buck4r ...
1097!> \param buckmo ...
1098!> \param gp ...
1099!> \param tersoff ...
1100!> \param siepmann ...
1101!> \param gal ...
1102!> \param gal21 ...
1103!> \param tab ...
1104!> \param deepmd ...
1105!> \param ace ...
1106!> \author Teodoro Laino [Teo] 11.2005
1107! **************************************************************************************************
1108 SUBROUTINE pair_potential_reallocate(p, lb1_new, ub1_new, lj, lj_charmm, williams, goodwin, eam, &
1109 nequip, bmhft, bmhftd, ipbv, buck4r, buckmo, &
1110 gp, tersoff, siepmann, gal, gal21, tab, deepmd, ace)
1111 TYPE(pair_potential_p_type), POINTER :: p
1112 INTEGER, INTENT(IN) :: lb1_new, ub1_new
1113 LOGICAL, INTENT(IN), OPTIONAL :: lj, lj_charmm, williams, goodwin, eam, nequip, bmhft, &
1114 bmhftd, ipbv, buck4r, buckmo, gp, tersoff, siepmann, gal, gal21, tab, deepmd, ace
1115
1116 INTEGER :: i, ipot, lb1_old, std_dim, ub1_old
1117 LOGICAL :: check, lace, lbmhft, lbmhftd, lbuck4r, lbuckmo, ldeepmd, leam, lgal, lgal21, &
1118 lgoodwin, lgp, lipbv, llj, llj_charmm, lnequip, lsiepmann, ltab, ltersoff, lwilliams
1119 TYPE(pair_potential_p_type), POINTER :: work
1120
1121 NULLIFY (work)
1122 ipot = 0
1123 llj = .false.; IF (PRESENT(lj)) llj = lj
1124 llj_charmm = .false.; IF (PRESENT(lj_charmm)) llj_charmm = lj_charmm
1125 lwilliams = .false.; IF (PRESENT(williams)) lwilliams = williams
1126 lgoodwin = .false.; IF (PRESENT(goodwin)) lgoodwin = goodwin
1127 leam = .false.; IF (PRESENT(eam)) leam = eam
1128 lnequip = .false.; IF (PRESENT(nequip)) lnequip = nequip
1129 lace = .false.; IF (PRESENT(ace)) lace = ace
1130 ldeepmd = .false.; IF (PRESENT(deepmd)) ldeepmd = deepmd
1131 lbmhft = .false.; IF (PRESENT(bmhft)) lbmhft = bmhft
1132 lbmhftd = .false.; IF (PRESENT(bmhftd)) lbmhftd = bmhftd
1133 lipbv = .false.; IF (PRESENT(ipbv)) lipbv = ipbv
1134 lbuck4r = .false.; IF (PRESENT(buck4r)) lbuck4r = buck4r
1135 lbuckmo = .false.; IF (PRESENT(buckmo)) lbuckmo = buckmo
1136 lgp = .false.; IF (PRESENT(gp)) lgp = gp
1137 ltersoff = .false.; IF (PRESENT(tersoff)) ltersoff = tersoff
1138 lsiepmann = .false.; IF (PRESENT(siepmann)) lsiepmann = siepmann
1139 lgal = .false.; IF (PRESENT(gal)) lgal = gal
1140 lgal21 = .false.; IF (PRESENT(gal21)) lgal21 = gal21
1141 ltab = .false.; IF (PRESENT(tab)) ltab = tab
1142
1143 IF (llj) THEN
1144 ipot = lj_type
1145 check = .NOT. (llj_charmm .OR. lwilliams .OR. lgoodwin .OR. leam .OR. lnequip &
1146 .OR. lbmhft .OR. lbmhftd .OR. lipbv .OR. lbuck4r .OR. lbuckmo .OR. lgp .OR. ltersoff &
1147 .OR. lsiepmann .OR. lgal .OR. lgal21 .OR. ltab .OR. ldeepmd .OR. lace)
1148 cpassert(check)
1149 END IF
1150 IF (llj_charmm) THEN
1151 ipot = lj_charmm_type
1152 check = .NOT. (llj .OR. lwilliams .OR. lgoodwin .OR. leam .OR. lnequip &
1153 .OR. lbmhft .OR. lbmhftd .OR. lipbv .OR. lbuck4r .OR. lbuckmo .OR. lgp .OR. ltersoff &
1154 .OR. lsiepmann .OR. lgal .OR. lgal21 .OR. ltab .OR. ldeepmd .OR. lace)
1155 cpassert(check)
1156 END IF
1157 IF (lwilliams) THEN
1158 ipot = wl_type
1159 check = .NOT. (llj .OR. llj_charmm .OR. lgoodwin .OR. leam .OR. lnequip &
1160 .OR. lbmhft .OR. lbmhftd .OR. lipbv .OR. lbuck4r .OR. lbuckmo .OR. lgp .OR. ltersoff &
1161 .OR. lsiepmann .OR. lgal .OR. lgal21 .OR. ltab .OR. ldeepmd .OR. lace)
1162 cpassert(check)
1163 END IF
1164 IF (lgoodwin) THEN
1165 ipot = gw_type
1166 check = .NOT. (llj .OR. llj_charmm .OR. lwilliams .OR. leam .OR. lnequip &
1167 .OR. lbmhft .OR. lbmhftd .OR. lipbv .OR. lbuck4r .OR. lbuckmo .OR. lgp .OR. ltersoff &
1168 .OR. lsiepmann .OR. lgal .OR. lgal21 .OR. ltab .OR. ldeepmd .OR. lace)
1169 cpassert(check)
1170 END IF
1171 IF (leam) THEN
1172 ipot = ea_type
1173 check = .NOT. (llj .OR. llj_charmm .OR. lgoodwin .OR. lwilliams .OR. lnequip &
1174 .OR. lbmhft .OR. lbmhftd .OR. lipbv .OR. lbuck4r .OR. lbuckmo .OR. lgp .OR. ltersoff &
1175 .OR. lsiepmann .OR. lgal .OR. lgal21 .OR. ltab .OR. ldeepmd .OR. lace)
1176 cpassert(check)
1177 END IF
1178 IF (lnequip) THEN
1179 ipot = nequip_type
1180 check = .NOT. (llj .OR. llj_charmm .OR. lgoodwin .OR. lwilliams .OR. leam &
1181 .OR. lbmhft .OR. lbmhftd .OR. lipbv .OR. lbuck4r .OR. lbuckmo .OR. lgp .OR. ltersoff &
1182 .OR. lsiepmann .OR. lgal .OR. lgal21 .OR. ltab .OR. ldeepmd .OR. lace)
1183 cpassert(check)
1184 END IF
1185 IF (lace) THEN
1186 ipot = ace_type
1187 check = .NOT. (llj .OR. llj_charmm .OR. lgoodwin .OR. lwilliams .OR. leam .OR. lnequip &
1188 .OR. lbmhft .OR. lbmhftd .OR. lipbv .OR. lbuck4r .OR. lbuckmo .OR. lgp &
1189 .OR. ltersoff .OR. lsiepmann .OR. lgal .OR. lgal21 .OR. ltab .OR. ldeepmd)
1190 cpassert(check)
1191 END IF
1192 IF (ldeepmd) THEN
1193 ipot = deepmd_type
1194 check = .NOT. (llj .OR. llj_charmm .OR. lgoodwin .OR. lwilliams .OR. leam .OR. lnequip &
1195 .OR. lbmhft .OR. lbmhftd .OR. lipbv .OR. lbuck4r .OR. lbuckmo .OR. lgp &
1196 .OR. ltersoff .OR. lsiepmann .OR. lgal .OR. lgal21 .OR. ltab .OR. lace)
1197 cpassert(check)
1198 END IF
1199 IF (lbmhft) THEN
1200 ipot = ft_type
1201 check = .NOT. (llj .OR. llj_charmm .OR. lgoodwin .OR. lwilliams .OR. leam .OR. lnequip &
1202 .OR. lbmhftd .OR. lipbv .OR. lbuck4r .OR. lbuckmo .OR. lgp .OR. ltersoff &
1203 .OR. lsiepmann .OR. lgal .OR. lgal21 .OR. ltab .OR. ldeepmd .OR. lace)
1204 cpassert(check)
1205 END IF
1206 IF (lbmhftd) THEN
1207 ipot = ftd_type
1208 check = .NOT. (llj .OR. llj_charmm .OR. lgoodwin .OR. lwilliams .OR. leam .OR. lnequip &
1209 .OR. lbmhft .OR. lipbv .OR. lbuck4r .OR. lbuckmo .OR. lgp .OR. ltersoff &
1210 .OR. lsiepmann .OR. lgal .OR. lgal21 .OR. ltab .OR. ldeepmd .OR. lace)
1211 cpassert(check)
1212 END IF
1213 IF (lipbv) THEN
1214 ipot = ip_type
1215 check = .NOT. (llj .OR. llj_charmm .OR. lgoodwin .OR. lwilliams .OR. leam .OR. lnequip &
1216 .OR. lbmhft .OR. lbmhftd .OR. lbuck4r .OR. lbuckmo .OR. lgp .OR. ltersoff &
1217 .OR. lsiepmann .OR. lgal .OR. lgal21 .OR. ltab .OR. ldeepmd .OR. lace)
1218 cpassert(check)
1219 END IF
1220 IF (lbuck4r) THEN
1221 ipot = b4_type
1222 check = .NOT. (llj .OR. llj_charmm .OR. lgoodwin .OR. lwilliams .OR. leam .OR. lnequip &
1223 .OR. lbmhft .OR. lbmhftd .OR. lipbv .OR. lbuckmo .OR. lgp .OR. ltersoff &
1224 .OR. lsiepmann .OR. lgal .OR. lgal21 .OR. ltab .OR. ldeepmd .OR. lace)
1225 cpassert(check)
1226 END IF
1227 IF (lbuckmo) THEN
1228 ipot = bm_type
1229 check = .NOT. (llj .OR. llj_charmm .OR. lgoodwin .OR. lwilliams .OR. leam .OR. lnequip &
1230 .OR. lbmhft .OR. lbmhftd .OR. lipbv .OR. lbuck4r .OR. lgp .OR. ltersoff &
1231 .OR. lsiepmann .OR. lgal .OR. lgal21 .OR. ltab .OR. ldeepmd .OR. lace)
1232 cpassert(check)
1233 END IF
1234 IF (ltersoff) THEN
1235 ipot = tersoff_type
1236 check = .NOT. (llj .OR. llj_charmm .OR. lgoodwin .OR. lwilliams .OR. leam .OR. lnequip &
1237 .OR. lbmhft .OR. lbmhftd .OR. lipbv .OR. lbuck4r .OR. lgp .OR. lbuckmo &
1238 .OR. lsiepmann .OR. lgal .OR. lgal21 .OR. ltab .OR. ldeepmd .OR. lace)
1239 cpassert(check)
1240 END IF
1241 IF (lsiepmann) THEN
1242 ipot = siepmann_type
1243 check = .NOT. (llj .OR. llj_charmm .OR. lgoodwin .OR. lwilliams .OR. leam .OR. lnequip &
1244 .OR. lbmhft .OR. lbmhftd .OR. lipbv .OR. lbuck4r .OR. lgp .OR. lbuckmo &
1245 .OR. ltersoff .OR. lgal .OR. lgal21 .OR. ltab .OR. ldeepmd .OR. lace)
1246 cpassert(check)
1247 END IF
1248 IF (lgal) THEN
1249 ipot = gal_type
1250 check = .NOT. (llj .OR. llj_charmm .OR. lgoodwin .OR. lwilliams .OR. leam .OR. lnequip &
1251 .OR. lbmhft .OR. lbmhftd .OR. lipbv .OR. lbuck4r .OR. lgp .OR. lbuckmo &
1252 .OR. ltersoff .OR. lsiepmann .OR. lgal21 .OR. ltab .OR. ldeepmd .OR. lace)
1253 cpassert(check)
1254 END IF
1255 IF (lgal21) THEN
1256 ipot = gal21_type
1257 check = .NOT. (llj .OR. llj_charmm .OR. lgoodwin .OR. lwilliams .OR. leam .OR. lnequip &
1258 .OR. lbmhft .OR. lbmhftd .OR. lipbv .OR. lbuck4r .OR. lgp .OR. lbuckmo &
1259 .OR. ltersoff .OR. lsiepmann .OR. lgal .OR. ltab .OR. ldeepmd .OR. lace)
1260 cpassert(check)
1261 END IF
1262 IF (lgp) THEN
1263 ipot = gp_type
1264 check = .NOT. (llj .OR. llj_charmm .OR. lgoodwin .OR. lwilliams .OR. leam .OR. lnequip &
1265 .OR. lbmhft .OR. lbmhftd .OR. lipbv .OR. lbuck4r .OR. lgal21 .OR. lbuckmo &
1266 .OR. ltersoff .OR. lsiepmann .OR. lgal .OR. ltab .OR. ldeepmd .OR. lace)
1267 cpassert(check)
1268 END IF
1269 IF (ltab) THEN
1270 ipot = tab_type
1271 check = .NOT. (llj .OR. llj_charmm .OR. lgoodwin .OR. lwilliams .OR. leam .OR. lnequip &
1272 .OR. lbmhft .OR. lbmhftd .OR. lipbv .OR. lbuck4r .OR. lgp .OR. lgal21 &
1273 .OR. lbuckmo .OR. ltersoff .OR. lsiepmann .OR. lgal .OR. lace)
1274 cpassert(check)
1275 END IF
1276
1277 lb1_old = 0
1278 ub1_old = 0
1279 IF (ASSOCIATED(p)) THEN
1280 lb1_old = lbound(p%pot, 1)
1281 ub1_old = ubound(p%pot, 1)
1282 CALL pair_potential_p_create(work, lb=lb1_old, ub=ub1_old)
1283 CALL pair_potential_p_copy(p, work)
1285 END IF
1286
1287 CALL pair_potential_p_create(p, lb=lb1_new, ub=ub1_new)
1288 IF (ASSOCIATED(work)) THEN
1289 CALL pair_potential_p_copy(work, p, istart=lb1_old, iend=ub1_old)
1290 END IF
1291 std_dim = 1
1292 DO i = ub1_old + 1, ub1_new
1293 check = (SIZE(p%pot(i)%pot%type) == std_dim) .AND. (SIZE(p%pot(i)%pot%type) == std_dim)
1294 cpassert(check)
1295 p%pot(i)%pot%type = nn_type
1296 p%pot(i)%pot%shell_type = nosh_nosh
1297 p%pot(i)%pot%undef = .true.
1298 p%pot(i)%pot%no_mb = .false.
1299 p%pot(i)%pot%no_pp = .false.
1300 p%pot(i)%pot%at1 = 'NULL'
1301 p%pot(i)%pot%at2 = 'NULL'
1302 p%pot(i)%pot%set(std_dim)%rmin = not_initialized
1303 p%pot(i)%pot%set(std_dim)%rmax = not_initialized
1304 SELECT CASE (ipot)
1305 CASE (lj_type, lj_charmm_type)
1306 CALL pair_potential_lj_create(p%pot(i)%pot%set(std_dim)%lj)
1307 CASE (wl_type)
1308 CALL pair_potential_williams_create(p%pot(i)%pot%set(std_dim)%willis)
1309 CASE (gw_type)
1310 CALL pair_potential_goodwin_create(p%pot(i)%pot%set(std_dim)%goodwin)
1311 CASE (ea_type)
1312 CALL pair_potential_eam_create(p%pot(i)%pot%set(std_dim)%eam)
1314 CALL pair_potential_nequip_create(p%pot(i)%pot%set(std_dim)%nequip)
1315 CASE (ace_type)
1316 CALL pair_potential_ace_create(p%pot(i)%pot%set(std_dim)%ace)
1317 CASE (deepmd_type)
1318 CALL pair_potential_deepmd_create(p%pot(i)%pot%set(std_dim)%deepmd)
1319 CASE (ft_type)
1320 CALL pair_potential_bmhft_create(p%pot(i)%pot%set(std_dim)%ft)
1321 CASE (ftd_type)
1322 CALL pair_potential_bmhftd_create(p%pot(i)%pot%set(std_dim)%ftd)
1323 CASE (ip_type)
1324 CALL pair_potential_ipbv_create(p%pot(i)%pot%set(std_dim)%ipbv)
1325 CASE (b4_type)
1326 CALL pair_potential_buck4r_create(p%pot(i)%pot%set(std_dim)%buck4r)
1327 CASE (bm_type)
1328 CALL pair_potential_buckmo_create(p%pot(i)%pot%set(std_dim)%buckmo)
1329 CASE (gp_type)
1330 CALL pair_potential_gp_create(p%pot(i)%pot%set(std_dim)%gp)
1331 CASE (tersoff_type)
1332 CALL pair_potential_tersoff_create(p%pot(i)%pot%set(std_dim)%tersoff)
1333 CASE (siepmann_type)
1334 CALL pair_potential_siepmann_create(p%pot(i)%pot%set(std_dim)%siepmann)
1335 CASE (gal_type)
1336 CALL pair_potential_gal_create(p%pot(i)%pot%set(std_dim)%gal)
1337 CASE (gal21_type)
1338 CALL pair_potential_gal21_create(p%pot(i)%pot%set(std_dim)%gal21)
1339 CASE (tab_type)
1340 CALL pair_potential_tab_create(p%pot(i)%pot%set(std_dim)%tab)
1341 END SELECT
1342 NULLIFY (p%pot(i)%pot%spl_f)
1343 NULLIFY (p%pot(i)%pot%pair_spline_data)
1344 END DO
1345
1346 IF (ASSOCIATED(work)) CALL pair_potential_p_release(work)
1347 END SUBROUTINE pair_potential_reallocate
1348
1349! **************************************************************************************************
1350!> \brief Creates the generic potential type
1351!> \param gp ...
1352!> \author Teodoro Laino [teo] 11.2005
1353! **************************************************************************************************
1354 SUBROUTINE pair_potential_gp_create(gp)
1355 TYPE(gp_pot_type), POINTER :: gp
1356
1357 cpassert(.NOT. ASSOCIATED(gp))
1358 ALLOCATE (gp)
1359 CALL pair_potential_gp_clean(gp)
1360 END SUBROUTINE pair_potential_gp_create
1361
1362! **************************************************************************************************
1363!> \brief Copy two generic potential type
1364!> \param gp_source ...
1365!> \param gp_dest ...
1366!> \author Teodoro Laino [teo] 11.2005
1367! **************************************************************************************************
1368 SUBROUTINE pair_potential_gp_copy(gp_source, gp_dest)
1369 TYPE(gp_pot_type), POINTER :: gp_source, gp_dest
1370
1371 INTEGER :: idim
1372
1373 IF (.NOT. ASSOCIATED(gp_source)) RETURN
1374 IF (ASSOCIATED(gp_dest)) CALL pair_potential_gp_release(gp_dest)
1375 CALL pair_potential_gp_create(gp_dest)
1376 gp_dest%myid = gp_source%myid
1377 gp_dest%potential = gp_source%potential
1378 gp_dest%variables = gp_source%variables
1379 IF (ALLOCATED(gp_source%parameters)) THEN
1380 idim = SIZE(gp_source%parameters)
1381 ALLOCATE (gp_dest%parameters(idim))
1382 gp_dest%parameters(:) = gp_source%parameters
1383 END IF
1384 IF (ALLOCATED(gp_source%values)) THEN
1385 idim = SIZE(gp_source%values)
1386 ALLOCATE (gp_dest%values(idim))
1387 gp_dest%values(:) = gp_source%values
1388 END IF
1389 END SUBROUTINE pair_potential_gp_copy
1390
1391! **************************************************************************************************
1392!> \brief Cleans the generic potential type
1393!> \param gp ...
1394!> \author Teodoro Laino [teo] 11.2005
1395! **************************************************************************************************
1396 SUBROUTINE pair_potential_gp_clean(gp)
1397 TYPE(gp_pot_type), POINTER :: gp
1398
1399 IF (.NOT. ASSOCIATED(gp)) RETURN
1400 gp%myid = 0
1401 gp%potential = ""
1402 gp%variables = ""
1403 IF (ALLOCATED(gp%values)) THEN
1404 DEALLOCATE (gp%values)
1405 END IF
1406 IF (ALLOCATED(gp%parameters)) THEN
1407 DEALLOCATE (gp%parameters)
1408 END IF
1409 END SUBROUTINE pair_potential_gp_clean
1410
1411! **************************************************************************************************
1412!> \brief Destroys the generic potential type
1413!> \param gp ...
1414!> \author Teodoro Laino [teo] 11.2005
1415! **************************************************************************************************
1416 SUBROUTINE pair_potential_gp_release(gp)
1417 TYPE(gp_pot_type), POINTER :: gp
1418
1419 IF (ASSOCIATED(gp)) THEN
1420 IF (ALLOCATED(gp%parameters)) THEN
1421 DEALLOCATE (gp%parameters)
1422 END IF
1423 IF (ALLOCATED(gp%values)) THEN
1424 DEALLOCATE (gp%values)
1425 END IF
1426 DEALLOCATE (gp)
1427 END IF
1428 NULLIFY (gp)
1429 END SUBROUTINE pair_potential_gp_release
1430
1431! **************************************************************************************************
1432!> \brief Cleans the LJ potential type
1433!> \param lj ...
1434!> \author Teodoro Laino [teo] 11.2005
1435! **************************************************************************************************
1437 TYPE(lj_pot_type), POINTER :: lj
1438
1439 cpassert(.NOT. ASSOCIATED(lj))
1440 ALLOCATE (lj)
1441 CALL pair_potential_lj_clean(lj)
1442 END SUBROUTINE pair_potential_lj_create
1443
1444! **************************************************************************************************
1445!> \brief Copy two LJ potential type
1446!> \param lj_source ...
1447!> \param lj_dest ...
1448!> \author Teodoro Laino [teo] 11.2005
1449! **************************************************************************************************
1450 SUBROUTINE pair_potential_lj_copy(lj_source, lj_dest)
1451 TYPE(lj_pot_type), POINTER :: lj_source, lj_dest
1452
1453 IF (.NOT. ASSOCIATED(lj_source)) RETURN
1454 IF (ASSOCIATED(lj_dest)) CALL pair_potential_lj_release(lj_dest)
1455 CALL pair_potential_lj_create(lj_dest)
1456 lj_dest%epsilon = lj_source%epsilon
1457 lj_dest%sigma6 = lj_source%sigma6
1458 lj_dest%sigma12 = lj_source%sigma12
1459 END SUBROUTINE pair_potential_lj_copy
1460
1461! **************************************************************************************************
1462!> \brief Creates the LJ potential type
1463!> \param lj ...
1464!> \author Teodoro Laino [teo] 11.2005
1465! **************************************************************************************************
1466 SUBROUTINE pair_potential_lj_clean(lj)
1467 TYPE(lj_pot_type), POINTER :: lj
1468
1469 IF (.NOT. ASSOCIATED(lj)) RETURN
1470 lj%epsilon = 0.0_dp
1471 lj%sigma6 = 0.0_dp
1472 lj%sigma12 = 0.0_dp
1473 END SUBROUTINE pair_potential_lj_clean
1474
1475! **************************************************************************************************
1476!> \brief Destroys the LJ potential type
1477!> \param lj ...
1478!> \author Teodoro Laino [teo] 11.2005
1479! **************************************************************************************************
1480 SUBROUTINE pair_potential_lj_release(lj)
1481 TYPE(lj_pot_type), POINTER :: lj
1482
1483 IF (ASSOCIATED(lj)) THEN
1484 DEALLOCATE (lj)
1485 END IF
1486 NULLIFY (lj)
1487 END SUBROUTINE pair_potential_lj_release
1488
1489! **************************************************************************************************
1490!> \brief Creates the WILLIAMS potential type
1491!> \param willis ...
1492!> \author Teodoro Laino [teo] 11.2005
1493! **************************************************************************************************
1494 SUBROUTINE pair_potential_williams_create(willis)
1495 TYPE(williams_pot_type), POINTER :: willis
1496
1497 cpassert(.NOT. ASSOCIATED(willis))
1498 ALLOCATE (willis)
1499 CALL pair_potential_williams_clean(willis)
1500 END SUBROUTINE pair_potential_williams_create
1501
1502! **************************************************************************************************
1503!> \brief Copy two WILLIAMS potential type
1504!> \param willis_source ...
1505!> \param willis_dest ...
1506!> \author Teodoro Laino [teo] 11.2005
1507! **************************************************************************************************
1508 SUBROUTINE pair_potential_williams_copy(willis_source, willis_dest)
1509 TYPE(williams_pot_type), POINTER :: willis_source, willis_dest
1510
1511 IF (.NOT. ASSOCIATED(willis_source)) RETURN
1512 IF (ASSOCIATED(willis_dest)) CALL pair_potential_williams_release(willis_dest)
1513 CALL pair_potential_williams_create(willis_dest)
1514 willis_dest%a = willis_source%a
1515 willis_dest%b = willis_source%b
1516 willis_dest%c = willis_source%c
1517 END SUBROUTINE pair_potential_williams_copy
1518
1519! **************************************************************************************************
1520!> \brief Creates the WILLIAMS potential type
1521!> \param willis ...
1522!> \author Teodoro Laino [teo] 11.2005
1523! **************************************************************************************************
1524 SUBROUTINE pair_potential_williams_clean(willis)
1525 TYPE(williams_pot_type), POINTER :: willis
1526
1527 IF (.NOT. ASSOCIATED(willis)) RETURN
1528 willis%a = 0.0_dp
1529 willis%b = 0.0_dp
1530 willis%c = 0.0_dp
1531 END SUBROUTINE pair_potential_williams_clean
1532
1533! **************************************************************************************************
1534!> \brief Destroys the WILLIAMS potential type
1535!> \param willis ...
1536!> \author Teodoro Laino [teo] 11.2005
1537! **************************************************************************************************
1538 SUBROUTINE pair_potential_williams_release(willis)
1539 TYPE(williams_pot_type), POINTER :: willis
1540
1541 IF (ASSOCIATED(willis)) THEN
1542 DEALLOCATE (willis)
1543 END IF
1544 NULLIFY (willis)
1545 END SUBROUTINE pair_potential_williams_release
1546
1547! **************************************************************************************************
1548!> \brief Creates the GOODWIN potential type
1549!> \param goodwin ...
1550!> \author Teodoro Laino [teo] 11.2005
1551! **************************************************************************************************
1552 SUBROUTINE pair_potential_goodwin_create(goodwin)
1553 TYPE(goodwin_pot_type), POINTER :: goodwin
1554
1555 cpassert(.NOT. ASSOCIATED(goodwin))
1556 ALLOCATE (goodwin)
1557 CALL pair_potential_goodwin_clean(goodwin)
1558 END SUBROUTINE pair_potential_goodwin_create
1559
1560! **************************************************************************************************
1561!> \brief Copy two GOODWIN potential type
1562!> \param goodwin_source ...
1563!> \param goodwin_dest ...
1564!> \author Teodoro Laino [teo] 11.2005
1565! **************************************************************************************************
1566 SUBROUTINE pair_potential_goodwin_copy(goodwin_source, goodwin_dest)
1567 TYPE(goodwin_pot_type), POINTER :: goodwin_source, goodwin_dest
1568
1569 IF (.NOT. ASSOCIATED(goodwin_source)) RETURN
1570 IF (ASSOCIATED(goodwin_dest)) CALL pair_potential_goodwin_release(goodwin_dest)
1571 CALL pair_potential_goodwin_create(goodwin_dest)
1572 goodwin_dest%vr0 = goodwin_source%vr0
1573 goodwin_dest%d = goodwin_source%d
1574 goodwin_dest%dc = goodwin_source%dc
1575 goodwin_dest%m = goodwin_source%m
1576 goodwin_dest%mc = goodwin_source%mc
1577 END SUBROUTINE pair_potential_goodwin_copy
1578
1579! **************************************************************************************************
1580!> \brief Creates the GOODWIN potential type
1581!> \param goodwin ...
1582!> \author Teodoro Laino [teo] 11.2005
1583! **************************************************************************************************
1584 SUBROUTINE pair_potential_goodwin_clean(goodwin)
1585 TYPE(goodwin_pot_type), POINTER :: goodwin
1586
1587 IF (.NOT. ASSOCIATED(goodwin)) RETURN
1588 goodwin%vr0 = 0.0_dp
1589 goodwin%d = 0.0_dp
1590 goodwin%dc = 0.0_dp
1591 goodwin%m = 0.0_dp
1592 goodwin%mc = 0.0_dp
1593 END SUBROUTINE pair_potential_goodwin_clean
1594
1595! **************************************************************************************************
1596!> \brief Destroys the GOODWIN potential type
1597!> \param goodwin ...
1598!> \author Teodoro Laino [teo] 11.2005
1599! **************************************************************************************************
1600 SUBROUTINE pair_potential_goodwin_release(goodwin)
1601 TYPE(goodwin_pot_type), POINTER :: goodwin
1602
1603 IF (ASSOCIATED(goodwin)) THEN
1604 DEALLOCATE (goodwin)
1605 END IF
1606 NULLIFY (goodwin)
1607 END SUBROUTINE pair_potential_goodwin_release
1608
1609! **************************************************************************************************
1610!> \brief Creates the EAM potential type
1611!> \param eam ...
1612!> \author Teodoro Laino [teo] 11.2005
1613! **************************************************************************************************
1614 SUBROUTINE pair_potential_eam_create(eam)
1615 TYPE(eam_pot_type), POINTER :: eam
1616
1617 cpassert(.NOT. ASSOCIATED(eam))
1618 ALLOCATE (eam)
1619 NULLIFY (eam%rho, eam%phi, eam%frho, eam%rhoval, eam%rval, &
1620 eam%rhop, eam%phip, eam%frhop)
1621 CALL pair_potential_eam_clean(eam)
1622 END SUBROUTINE pair_potential_eam_create
1623
1624! **************************************************************************************************
1625!> \brief Copy two EAM potential type
1626!> \param eam_source ...
1627!> \param eam_dest ...
1628!> \author Teodoro Laino [teo] 11.2005
1629! **************************************************************************************************
1630 SUBROUTINE pair_potential_eam_copy(eam_source, eam_dest)
1631 TYPE(eam_pot_type), POINTER :: eam_source, eam_dest
1632
1633 IF (.NOT. ASSOCIATED(eam_source)) RETURN
1634 IF (ASSOCIATED(eam_dest)) CALL pair_potential_eam_release(eam_dest)
1635 CALL pair_potential_eam_create(eam_dest)
1636 eam_dest%eam_file_name = eam_source%eam_file_name
1637 eam_dest%drar = eam_source%drar
1638 eam_dest%drhoar = eam_source%drhoar
1639 eam_dest%acutal = eam_source%acutal
1640 eam_dest%npoints = eam_source%npoints
1641 ! Allocate arrays with the proper size
1642 CALL reallocate(eam_dest%rho, 1, eam_dest%npoints)
1643 CALL reallocate(eam_dest%rhop, 1, eam_dest%npoints)
1644 CALL reallocate(eam_dest%phi, 1, eam_dest%npoints)
1645 CALL reallocate(eam_dest%phip, 1, eam_dest%npoints)
1646 CALL reallocate(eam_dest%frho, 1, eam_dest%npoints)
1647 CALL reallocate(eam_dest%frhop, 1, eam_dest%npoints)
1648 CALL reallocate(eam_dest%rval, 1, eam_dest%npoints)
1649 CALL reallocate(eam_dest%rhoval, 1, eam_dest%npoints)
1650 eam_dest%rho = eam_source%rho
1651 eam_dest%phi = eam_source%phi
1652 eam_dest%frho = eam_source%frho
1653 eam_dest%rhoval = eam_source%rhoval
1654 eam_dest%rval = eam_source%rval
1655 eam_dest%rhop = eam_source%rhop
1656 eam_dest%phip = eam_source%phip
1657 eam_dest%frhop = eam_source%frhop
1658 END SUBROUTINE pair_potential_eam_copy
1659
1660! **************************************************************************************************
1661!> \brief Creates the EAM potential type
1662!> \param eam ...
1663!> \author Teodoro Laino [teo] 11.2005
1664! **************************************************************************************************
1665 SUBROUTINE pair_potential_eam_clean(eam)
1666 TYPE(eam_pot_type), POINTER :: eam
1667
1668 IF (.NOT. ASSOCIATED(eam)) RETURN
1669 eam%eam_file_name = 'NULL'
1670 eam%drar = 0.0_dp
1671 eam%drhoar = 0.0_dp
1672 eam%acutal = 0.0_dp
1673 eam%npoints = 0
1674 CALL reallocate(eam%rho, 1, eam%npoints)
1675 CALL reallocate(eam%rhop, 1, eam%npoints)
1676 CALL reallocate(eam%phi, 1, eam%npoints)
1677 CALL reallocate(eam%phip, 1, eam%npoints)
1678 CALL reallocate(eam%frho, 1, eam%npoints)
1679 CALL reallocate(eam%frhop, 1, eam%npoints)
1680 CALL reallocate(eam%rval, 1, eam%npoints)
1681 CALL reallocate(eam%rhoval, 1, eam%npoints)
1682 END SUBROUTINE pair_potential_eam_clean
1683
1684! **************************************************************************************************
1685!> \brief Destroys the EAM potential type
1686!> \param eam ...
1687!> \author Teodoro Laino [teo] 11.2005
1688! **************************************************************************************************
1689 SUBROUTINE pair_potential_eam_release(eam)
1690 TYPE(eam_pot_type), POINTER :: eam
1691
1692 IF (ASSOCIATED(eam)) THEN
1693 IF (ASSOCIATED(eam%rho)) THEN
1694 DEALLOCATE (eam%rho)
1695 END IF
1696 IF (ASSOCIATED(eam%rhop)) THEN
1697 DEALLOCATE (eam%rhop)
1698 END IF
1699 IF (ASSOCIATED(eam%phi)) THEN
1700 DEALLOCATE (eam%phi)
1701 END IF
1702 IF (ASSOCIATED(eam%phip)) THEN
1703 DEALLOCATE (eam%phip)
1704 END IF
1705 IF (ASSOCIATED(eam%frho)) THEN
1706 DEALLOCATE (eam%frho)
1707 END IF
1708 IF (ASSOCIATED(eam%frhop)) THEN
1709 DEALLOCATE (eam%frhop)
1710 END IF
1711 IF (ASSOCIATED(eam%rval)) THEN
1712 DEALLOCATE (eam%rval)
1713 END IF
1714 IF (ASSOCIATED(eam%rhoval)) THEN
1715 DEALLOCATE (eam%rhoval)
1716 END IF
1717 DEALLOCATE (eam)
1718 END IF
1719 END SUBROUTINE pair_potential_eam_release
1720
1721! **************************************************************************************************
1722!> \brief Creates the ACE potential type
1723!> \param ace ...
1724!> \author
1725! **************************************************************************************************
1726 SUBROUTINE pair_potential_ace_create(ace)
1727 TYPE(ace_pot_type), POINTER :: ace
1728
1729 cpassert(.NOT. ASSOCIATED(ace))
1730 ALLOCATE (ace)
1731 END SUBROUTINE pair_potential_ace_create
1732
1733! **************************************************************************************************
1734!> \brief Copy two ACE potential type
1735!> \param ace_source ...
1736!> \param ace_dest ...
1737!> \author
1738! **************************************************************************************************
1739 SUBROUTINE pair_potential_ace_copy(ace_source, ace_dest)
1740 TYPE(ace_pot_type), POINTER :: ace_source, ace_dest
1741
1742 IF (.NOT. ASSOCIATED(ace_source)) RETURN
1743 NULLIFY (ace_dest)
1744 IF (ASSOCIATED(ace_dest)) CALL pair_potential_ace_release(ace_dest)
1745 CALL pair_potential_ace_create(ace_dest)
1746 ace_dest = ace_source
1747 END SUBROUTINE pair_potential_ace_copy
1748
1749! **************************************************************************************************
1750!> \brief CLEAN the ACE potential type
1751!> \param ace ...
1752!> \author
1753! **************************************************************************************************
1754 SUBROUTINE pair_potential_ace_clean(ace)
1755 TYPE(ace_pot_type), POINTER :: ace
1756
1757 IF (.NOT. ASSOCIATED(ace)) RETURN
1758 ace = ace_pot_type()
1759 END SUBROUTINE pair_potential_ace_clean
1760
1761! **************************************************************************************************
1762!> \brief Destroys the ACE potential type
1763!> \param ace ...
1764!> \author
1765! **************************************************************************************************
1766 SUBROUTINE pair_potential_ace_release(ace)
1767 TYPE(ace_pot_type), POINTER :: ace
1768
1769 IF (ASSOCIATED(ace)) THEN
1770 DEALLOCATE (ace)
1771 END IF
1772 END SUBROUTINE pair_potential_ace_release
1773
1774! **************************************************************************************************
1775!> \brief Creates the DEEPMD potential type
1776!> \param deepmd ...
1777!> \author Yongbin Zhuang 07.2019
1778! **************************************************************************************************
1779 SUBROUTINE pair_potential_deepmd_create(deepmd)
1780 TYPE(deepmd_pot_type), POINTER :: deepmd
1781
1782 cpassert(.NOT. ASSOCIATED(deepmd))
1783 ALLOCATE (deepmd)
1784 END SUBROUTINE pair_potential_deepmd_create
1785
1786! **************************************************************************************************
1787!> \brief Copy two DEEPMD potential type
1788!> \param deepmd_source ...
1789!> \param deepmd_dest ...
1790!> \author Yongbin Zhuang 07.2019
1791! **************************************************************************************************
1792 SUBROUTINE pair_potential_deepmd_copy(deepmd_source, deepmd_dest)
1793 TYPE(deepmd_pot_type), POINTER :: deepmd_source, deepmd_dest
1794
1795 IF (.NOT. ASSOCIATED(deepmd_source)) RETURN
1796 NULLIFY (deepmd_dest)
1797 IF (ASSOCIATED(deepmd_dest)) CALL pair_potential_deepmd_release(deepmd_dest)
1798 CALL pair_potential_deepmd_create(deepmd_dest)
1799 deepmd_dest = deepmd_source
1800 END SUBROUTINE pair_potential_deepmd_copy
1801
1802! **************************************************************************************************
1803!> \brief CLEAN the DEEPMD potential type
1804!> \param deepmd ...
1805!> \author Yongbin Zhuang 07.2019
1806! **************************************************************************************************
1807 SUBROUTINE pair_potential_deepmd_clean(deepmd)
1808 TYPE(deepmd_pot_type), POINTER :: deepmd
1809
1810 IF (.NOT. ASSOCIATED(deepmd)) RETURN
1811 deepmd = deepmd_pot_type()
1812 END SUBROUTINE pair_potential_deepmd_clean
1813
1814! **************************************************************************************************
1815!> \brief Destroys the DEEPMD potential type
1816!> \param deepmd ...
1817!> \author Yongbin Zhuang 07.2019
1818! **************************************************************************************************
1819 SUBROUTINE pair_potential_deepmd_release(deepmd)
1820 TYPE(deepmd_pot_type), POINTER :: deepmd
1821
1822 IF (ASSOCIATED(deepmd)) THEN
1823 DEALLOCATE (deepmd)
1824 END IF
1825 END SUBROUTINE pair_potential_deepmd_release
1826
1827! **************************************************************************************************
1828!> \brief Creates the NEQUIP potential type
1829!> \param nequip ...
1830!> \author Gabriele Tocci 2023
1831! **************************************************************************************************
1832 SUBROUTINE pair_potential_nequip_create(nequip)
1833 TYPE(nequip_pot_type), POINTER :: nequip
1834
1835 cpassert(.NOT. ASSOCIATED(nequip))
1836 ALLOCATE (nequip)
1837 END SUBROUTINE pair_potential_nequip_create
1838
1839! **************************************************************************************************
1840!> \brief Copy two NEQUIP potential type
1841!> \param nequip_source ...
1842!> \param nequip_dest ...
1843!> \author Gabriele Tocci 2023
1844! **************************************************************************************************
1845 SUBROUTINE pair_potential_nequip_copy(nequip_source, nequip_dest)
1846 TYPE(nequip_pot_type), POINTER :: nequip_source, nequip_dest
1847
1848 IF (.NOT. ASSOCIATED(nequip_source)) RETURN
1849 IF (ASSOCIATED(nequip_dest)) CALL pair_potential_nequip_release(nequip_dest)
1850 CALL pair_potential_nequip_create(nequip_dest)
1851 nequip_dest = nequip_source
1852
1853 END SUBROUTINE pair_potential_nequip_copy
1854
1855! **************************************************************************************************
1856!> \brief Creates the NEQUIP potential type
1857!> \param nequip ...
1858!> \author Gabriele Tocci 2023
1859! **************************************************************************************************
1860 SUBROUTINE pair_potential_nequip_clean(nequip)
1861 TYPE(nequip_pot_type), POINTER :: nequip
1862
1863 IF (.NOT. ASSOCIATED(nequip)) RETURN
1864 nequip = nequip_pot_type()
1865
1866 END SUBROUTINE pair_potential_nequip_clean
1867
1868! **************************************************************************************************
1869!> \brief Destroys the NEQUIP potential type
1870!> \param nequip ...
1871!> \author Gabriele Tocci 2023
1872! **************************************************************************************************
1873 SUBROUTINE pair_potential_nequip_release(nequip)
1874 TYPE(nequip_pot_type), POINTER :: nequip
1875
1876 IF (ASSOCIATED(nequip)) THEN
1877 DEALLOCATE (nequip)
1878 END IF
1879 END SUBROUTINE pair_potential_nequip_release
1880
1881! **************************************************************************************************
1882!> \brief Creates the BMHFT (TOSI-FUMI) potential type
1883!> \param ft ...
1884!> \author Teodoro Laino [teo] 11.2005
1885! **************************************************************************************************
1886 SUBROUTINE pair_potential_bmhft_create(ft)
1887 TYPE(ft_pot_type), POINTER :: ft
1888
1889 cpassert(.NOT. ASSOCIATED(ft))
1890 ALLOCATE (ft)
1891 CALL pair_potential_bmhft_clean(ft)
1892 END SUBROUTINE pair_potential_bmhft_create
1893
1894! **************************************************************************************************
1895!> \brief Copy two BMHFT (TOSI-FUMI) potential type
1896!> \param ft_source ...
1897!> \param ft_dest ...
1898!> \author Teodoro Laino [teo] 11.2005
1899! **************************************************************************************************
1900 SUBROUTINE pair_potential_bmhft_copy(ft_source, ft_dest)
1901 TYPE(ft_pot_type), POINTER :: ft_source, ft_dest
1902
1903 IF (.NOT. ASSOCIATED(ft_source)) RETURN
1904 IF (ASSOCIATED(ft_dest)) CALL pair_potential_bmhft_release(ft_dest)
1905 CALL pair_potential_bmhft_create(ft_dest)
1906 ft_dest%A = ft_source%A
1907 ft_dest%B = ft_source%B
1908 ft_dest%C = ft_source%C
1909 ft_dest%D = ft_source%D
1910 END SUBROUTINE pair_potential_bmhft_copy
1911
1912! **************************************************************************************************
1913!> \brief Creates the BMHFT (TOSI-FUMI) potential type
1914!> \param ft ...
1915!> \author Teodoro Laino [teo] 11.2005
1916! **************************************************************************************************
1917 SUBROUTINE pair_potential_bmhft_clean(ft)
1918 TYPE(ft_pot_type), POINTER :: ft
1919
1920 IF (.NOT. ASSOCIATED(ft)) RETURN
1921 ft%A = 0.0_dp
1922 ft%B = 0.0_dp
1923 ft%C = 0.0_dp
1924 ft%D = 0.0_dp
1925 END SUBROUTINE pair_potential_bmhft_clean
1926
1927! **************************************************************************************************
1928!> \brief Destroys the BMHFT potential type
1929!> \param ft ...
1930!> \author Teodoro Laino [teo] 11.2005
1931! **************************************************************************************************
1932 SUBROUTINE pair_potential_bmhft_release(ft)
1933 TYPE(ft_pot_type), POINTER :: ft
1934
1935 IF (ASSOCIATED(ft)) THEN
1936 DEALLOCATE (ft)
1937 END IF
1938 NULLIFY (ft)
1939 END SUBROUTINE pair_potential_bmhft_release
1940
1941! **************************************************************************************************
1942!> \brief Creates the BMHFTD (damped TOSI-FUMI) potential type
1943!> \param ftd ...
1944!> \author Mathieu Salanne 05.2010
1945! **************************************************************************************************
1946 SUBROUTINE pair_potential_bmhftd_create(ftd)
1947 TYPE(ftd_pot_type), POINTER :: ftd
1948
1949 cpassert(.NOT. ASSOCIATED(ftd))
1950 ALLOCATE (ftd)
1951 CALL pair_potential_bmhftd_clean(ftd)
1952 END SUBROUTINE pair_potential_bmhftd_create
1953
1954! **************************************************************************************************
1955!> \brief Copy two BMHFTD (Damped TOSI-FUMI) potential type
1956!> \param ftd_source ...
1957!> \param ftd_dest ...
1958!> \author Mathieu Salanne 05.2010
1959! **************************************************************************************************
1960 SUBROUTINE pair_potential_bmhftd_copy(ftd_source, ftd_dest)
1961 TYPE(ftd_pot_type), POINTER :: ftd_source, ftd_dest
1962
1963 IF (.NOT. ASSOCIATED(ftd_source)) RETURN
1964 IF (ASSOCIATED(ftd_dest)) CALL pair_potential_bmhftd_release(ftd_dest)
1965 CALL pair_potential_bmhftd_create(ftd_dest)
1966 ftd_dest%A = ftd_source%A
1967 ftd_dest%B = ftd_source%B
1968 ftd_dest%C = ftd_source%C
1969 ftd_dest%D = ftd_source%D
1970 ftd_dest%BD = ftd_source%BD
1971 END SUBROUTINE pair_potential_bmhftd_copy
1972
1973! **************************************************************************************************
1974!> \brief Cleans the BMHFTD (damped TOSI-FUMI) potential type
1975!> \param ftd ...
1976!> \author Mathieu Salanne
1977! **************************************************************************************************
1978 SUBROUTINE pair_potential_bmhftd_clean(ftd)
1979 TYPE(ftd_pot_type), POINTER :: ftd
1980
1981 IF (.NOT. ASSOCIATED(ftd)) RETURN
1982 ftd%A = 0.0_dp
1983 ftd%B = 0.0_dp
1984 ftd%C = 0.0_dp
1985 ftd%D = 0.0_dp
1986 ftd%BD = 0.0_dp
1987 END SUBROUTINE pair_potential_bmhftd_clean
1988
1989! **************************************************************************************************
1990!> \brief Destroys the BMHFTD potential type
1991!> \param ftd ...
1992!> \author Mathieu Salanne 05.2010
1993! **************************************************************************************************
1994 SUBROUTINE pair_potential_bmhftd_release(ftd)
1995 TYPE(ftd_pot_type), POINTER :: ftd
1996
1997 IF (ASSOCIATED(ftd)) THEN
1998 DEALLOCATE (ftd)
1999 END IF
2000 NULLIFY (ftd)
2001 END SUBROUTINE pair_potential_bmhftd_release
2002
2003! **************************************************************************************************
2004!> \brief Creates the IPBV potential type
2005!> \param ipbv ...
2006!> \author Teodoro Laino [teo] 11.2005
2007! **************************************************************************************************
2008 SUBROUTINE pair_potential_ipbv_create(ipbv)
2009 TYPE(ipbv_pot_type), POINTER :: ipbv
2010
2011 cpassert(.NOT. ASSOCIATED(ipbv))
2012 ALLOCATE (ipbv)
2013 CALL pair_potential_ipbv_clean(ipbv)
2014 END SUBROUTINE pair_potential_ipbv_create
2015
2016! **************************************************************************************************
2017!> \brief Copy two IPBV potential type
2018!> \param ipbv_source ...
2019!> \param ipbv_dest ...
2020!> \author Teodoro Laino [teo] 11.2005
2021! **************************************************************************************************
2022 SUBROUTINE pair_potential_ipbv_copy(ipbv_source, ipbv_dest)
2023 TYPE(ipbv_pot_type), POINTER :: ipbv_source, ipbv_dest
2024
2025 IF (.NOT. ASSOCIATED(ipbv_source)) RETURN
2026 IF (ASSOCIATED(ipbv_dest)) CALL pair_potential_ipbv_release(ipbv_dest)
2027 CALL pair_potential_ipbv_create(ipbv_dest)
2028 ipbv_dest%a = ipbv_source%a
2029 ipbv_dest%rcore = ipbv_source%rcore
2030 ipbv_dest%b = ipbv_source%b
2031 ipbv_dest%m = ipbv_source%m
2032 END SUBROUTINE pair_potential_ipbv_copy
2033
2034! **************************************************************************************************
2035!> \brief Creates the IPBV potential type
2036!> \param ipbv ...
2037!> \author Teodoro Laino [teo] 11.2005
2038! **************************************************************************************************
2039 SUBROUTINE pair_potential_ipbv_clean(ipbv)
2040 TYPE(ipbv_pot_type), POINTER :: ipbv
2041
2042 IF (.NOT. ASSOCIATED(ipbv)) RETURN
2043 ipbv%a = 0.0_dp
2044 ipbv%rcore = 0.0_dp
2045 ipbv%b = 0.0_dp
2046 ipbv%m = 0.0_dp
2047 END SUBROUTINE pair_potential_ipbv_clean
2048
2049! **************************************************************************************************
2050!> \brief Destroys the IPBV potential type
2051!> \param ipbv ...
2052!> \author Teodoro Laino [teo] 11.2005
2053! **************************************************************************************************
2054 SUBROUTINE pair_potential_ipbv_release(ipbv)
2055 TYPE(ipbv_pot_type), POINTER :: ipbv
2056
2057 IF (ASSOCIATED(ipbv)) THEN
2058 DEALLOCATE (ipbv)
2059 END IF
2060 NULLIFY (ipbv)
2061 END SUBROUTINE pair_potential_ipbv_release
2062
2063! **************************************************************************************************
2064!> \brief Creates the Buckingham 4 ranges potential type
2065!> \param buck4r ...
2066!> \author MI 10.2006
2067! **************************************************************************************************
2068 SUBROUTINE pair_potential_buck4r_create(buck4r)
2069 TYPE(buck4ran_pot_type), POINTER :: buck4r
2070
2071 cpassert(.NOT. ASSOCIATED(buck4r))
2072 ALLOCATE (buck4r)
2073 CALL pair_potential_buck4r_clean(buck4r)
2074 END SUBROUTINE pair_potential_buck4r_create
2075
2076! **************************************************************************************************
2077!> \brief Copy two Buckingham 4 ranges potential type
2078!> \param buck4r_source ...
2079!> \param buck4r_dest ...
2080!> \author MI 10.2006
2081! **************************************************************************************************
2082 SUBROUTINE pair_potential_buck4r_copy(buck4r_source, buck4r_dest)
2083 TYPE(buck4ran_pot_type), POINTER :: buck4r_source, buck4r_dest
2084
2085 IF (.NOT. ASSOCIATED(buck4r_source)) RETURN
2086 IF (ASSOCIATED(buck4r_dest)) CALL pair_potential_buck4r_release(buck4r_dest)
2087 CALL pair_potential_buck4r_create(buck4r_dest)
2088 buck4r_dest%a = buck4r_source%a
2089 buck4r_dest%b = buck4r_source%b
2090 buck4r_dest%c = buck4r_source%c
2091 buck4r_dest%r1 = buck4r_source%r1
2092 buck4r_dest%r2 = buck4r_source%r2
2093 buck4r_dest%r3 = buck4r_source%r3
2094 buck4r_dest%poly1 = buck4r_source%poly1
2095 buck4r_dest%poly2 = buck4r_source%poly2
2096 buck4r_dest%npoly1 = buck4r_source%npoly1
2097 buck4r_dest%npoly2 = buck4r_source%npoly2
2098 END SUBROUTINE pair_potential_buck4r_copy
2099
2100! **************************************************************************************************
2101!> \brief Creates the Buckingham 4 ranges potential type
2102!> \param buck4r ...
2103!> \author MI 10.2006
2104! **************************************************************************************************
2105 SUBROUTINE pair_potential_buck4r_clean(buck4r)
2106 TYPE(buck4ran_pot_type), POINTER :: buck4r
2107
2108 IF (.NOT. ASSOCIATED(buck4r)) RETURN
2109 buck4r%a = 0.0_dp
2110 buck4r%b = 0.0_dp
2111 buck4r%c = 0.0_dp
2112 buck4r%r1 = 0.0_dp
2113 buck4r%r2 = 0.0_dp
2114 buck4r%r3 = 0.0_dp
2115 buck4r%poly1 = 0.0_dp
2116 buck4r%npoly1 = 0
2117 buck4r%poly2 = 0.0_dp
2118 buck4r%npoly2 = 0
2119 END SUBROUTINE pair_potential_buck4r_clean
2120
2121! **************************************************************************************************
2122!> \brief Destroys the Buckingham 4 ranges potential type
2123!> \param buck4r ...
2124!> \author MI 10.2006
2125! **************************************************************************************************
2126 SUBROUTINE pair_potential_buck4r_release(buck4r)
2127 TYPE(buck4ran_pot_type), POINTER :: buck4r
2128
2129 IF (ASSOCIATED(buck4r)) THEN
2130 DEALLOCATE (buck4r)
2131 END IF
2132 NULLIFY (buck4r)
2133 END SUBROUTINE pair_potential_buck4r_release
2134
2135! **************************************************************************************************
2136!> \brief Creates the Buckingham plus Morse potential type
2137!> \param buckmo ...
2138!> \author MI 10.2006
2139! **************************************************************************************************
2140 SUBROUTINE pair_potential_buckmo_create(buckmo)
2141 TYPE(buckmorse_pot_type), POINTER :: buckmo
2142
2143 cpassert(.NOT. ASSOCIATED(buckmo))
2144 ALLOCATE (buckmo)
2145 CALL pair_potential_buckmo_clean(buckmo)
2146 END SUBROUTINE pair_potential_buckmo_create
2147
2148! **************************************************************************************************
2149!> \brief Copy two Buckingham plus Morse potential type
2150!> \param buckmo_source ...
2151!> \param buckmo_dest ...
2152!> \author MI 10.2006
2153! **************************************************************************************************
2154 SUBROUTINE pair_potential_buckmo_copy(buckmo_source, buckmo_dest)
2155 TYPE(buckmorse_pot_type), POINTER :: buckmo_source, buckmo_dest
2156
2157 IF (.NOT. ASSOCIATED(buckmo_source)) RETURN
2158 IF (ASSOCIATED(buckmo_dest)) CALL pair_potential_buckmo_release(buckmo_dest)
2159 CALL pair_potential_buckmo_create(buckmo_dest)
2160 buckmo_dest%f0 = buckmo_source%f0
2161 buckmo_dest%a1 = buckmo_source%a1
2162 buckmo_dest%a2 = buckmo_source%a2
2163 buckmo_dest%b1 = buckmo_source%b1
2164 buckmo_dest%b2 = buckmo_source%b2
2165 buckmo_dest%c = buckmo_source%c
2166 buckmo_dest%d = buckmo_source%d
2167 buckmo_dest%r0 = buckmo_source%r0
2168 buckmo_dest%beta = buckmo_source%beta
2169 END SUBROUTINE pair_potential_buckmo_copy
2170
2171! **************************************************************************************************
2172!> \brief Creates the Buckingham plus Morse potential type
2173!> \param buckmo ...
2174!> \author MI 10.2006
2175! **************************************************************************************************
2176 SUBROUTINE pair_potential_buckmo_clean(buckmo)
2177 TYPE(buckmorse_pot_type), POINTER :: buckmo
2178
2179 IF (.NOT. ASSOCIATED(buckmo)) RETURN
2180 buckmo%f0 = 0.0_dp
2181 buckmo%a1 = 0.0_dp
2182 buckmo%a2 = 0.0_dp
2183 buckmo%b1 = 0.0_dp
2184 buckmo%b2 = 0.0_dp
2185 buckmo%c = 0.0_dp
2186 buckmo%d = 0.0_dp
2187 buckmo%r0 = 0.0_dp
2188 buckmo%beta = 0.0_dp
2189 END SUBROUTINE pair_potential_buckmo_clean
2190
2191! **************************************************************************************************
2192!> \brief Destroys the Buckingham plus Morse potential type
2193!> \param buckmo ...
2194!> \author MI 10.2006
2195! **************************************************************************************************
2196 SUBROUTINE pair_potential_buckmo_release(buckmo)
2197 TYPE(buckmorse_pot_type), POINTER :: buckmo
2198
2199 IF (ASSOCIATED(buckmo)) THEN
2200 DEALLOCATE (buckmo)
2201 END IF
2202 NULLIFY (buckmo)
2203 END SUBROUTINE pair_potential_buckmo_release
2204
2205! **************************************************************************************************
2206!> \brief Creates the Tersoff potential type
2207!> (Tersoff, J. PRB 39(8), 5566, 1989)
2208!> \param tersoff ...
2209! **************************************************************************************************
2210 SUBROUTINE pair_potential_tersoff_create(tersoff)
2211 TYPE(tersoff_pot_type), POINTER :: tersoff
2212
2213 cpassert(.NOT. ASSOCIATED(tersoff))
2214 ALLOCATE (tersoff)
2215 CALL pair_potential_tersoff_clean(tersoff)
2216 END SUBROUTINE pair_potential_tersoff_create
2217
2218! **************************************************************************************************
2219!> \brief Copy two Tersoff potential type
2220!> (Tersoff, J. PRB 39(8), 5566, 1989)
2221!> \param tersoff_source ...
2222!> \param tersoff_dest ...
2223! **************************************************************************************************
2224 SUBROUTINE pair_potential_tersoff_copy(tersoff_source, tersoff_dest)
2225 TYPE(tersoff_pot_type), POINTER :: tersoff_source, tersoff_dest
2226
2227 IF (.NOT. ASSOCIATED(tersoff_source)) RETURN
2228 IF (ASSOCIATED(tersoff_dest)) CALL pair_potential_tersoff_release(tersoff_dest)
2229 CALL pair_potential_tersoff_create(tersoff_dest)
2230 tersoff_dest%A = tersoff_source%A
2231 tersoff_dest%B = tersoff_source%B
2232 tersoff_dest%lambda1 = tersoff_source%lambda1
2233 tersoff_dest%lambda2 = tersoff_source%lambda2
2234 tersoff_dest%alpha = tersoff_source%alpha
2235 tersoff_dest%beta = tersoff_source%beta
2236 tersoff_dest%n = tersoff_source%n
2237 tersoff_dest%c = tersoff_source%c
2238 tersoff_dest%d = tersoff_source%d
2239 tersoff_dest%h = tersoff_source%h
2240 tersoff_dest%lambda3 = tersoff_source%lambda3
2241 tersoff_dest%bigR = tersoff_source%bigR
2242 tersoff_dest%bigD = tersoff_source%bigD
2243 tersoff_dest%rcutsq = tersoff_source%rcutsq
2244 END SUBROUTINE pair_potential_tersoff_copy
2245
2246! **************************************************************************************************
2247!> \brief Creates the Tersoff potential type
2248!> (Tersoff, J. PRB 39(8), 5566, 1989)
2249!> \param tersoff ...
2250! **************************************************************************************************
2251 SUBROUTINE pair_potential_tersoff_clean(tersoff)
2252 TYPE(tersoff_pot_type), POINTER :: tersoff
2253
2254 IF (.NOT. ASSOCIATED(tersoff)) RETURN
2255 tersoff%A = 0.0_dp
2256 tersoff%B = 0.0_dp
2257 tersoff%lambda1 = 0.0_dp
2258 tersoff%lambda2 = 0.0_dp
2259 tersoff%alpha = 0.0_dp
2260 tersoff%beta = 0.0_dp
2261 tersoff%n = 0.0_dp
2262 tersoff%c = 0.0_dp
2263 tersoff%d = 0.0_dp
2264 tersoff%h = 0.0_dp
2265 tersoff%lambda3 = 0.0_dp
2266 tersoff%bigR = 0.0_dp
2267 tersoff%bigD = 0.0_dp
2268 tersoff%rcutsq = 0.0_dp
2269 END SUBROUTINE pair_potential_tersoff_clean
2270
2271! **************************************************************************************************
2272!> \brief Destroys the Tersoff
2273!> (Tersoff, J. PRB 39(8), 5566, 1989)
2274!> \param tersoff ...
2275! **************************************************************************************************
2276 SUBROUTINE pair_potential_tersoff_release(tersoff)
2277 TYPE(tersoff_pot_type), POINTER :: tersoff
2278
2279 IF (ASSOCIATED(tersoff)) THEN
2280 DEALLOCATE (tersoff)
2281 END IF
2282 NULLIFY (tersoff)
2283 END SUBROUTINE pair_potential_tersoff_release
2284
2285! **************************************************************************************************
2286!> \brief Creates the Siepmann-Sprik potential type
2287!> (Siepmann and Sprik, J. Chem. Phys. 102(1) 511, 1995)
2288!> \param siepmann ...
2289! **************************************************************************************************
2290 SUBROUTINE pair_potential_siepmann_create(siepmann)
2291 TYPE(siepmann_pot_type), POINTER :: siepmann
2292
2293 cpassert(.NOT. ASSOCIATED(siepmann))
2294 ALLOCATE (siepmann)
2295 CALL pair_potential_siepmann_clean(siepmann)
2296 END SUBROUTINE pair_potential_siepmann_create
2297! **************************************************************************************************
2298!> \brief Copy two Siepmann potential type
2299!> (Siepmann and Sprik, J. Chem. Phys. 102(1) 511, 1995)
2300!> \param siepmann_source ...
2301!> \param siepmann_dest ...
2302! **************************************************************************************************
2303 SUBROUTINE pair_potential_siepmann_copy(siepmann_source, siepmann_dest)
2304 TYPE(siepmann_pot_type), POINTER :: siepmann_source, siepmann_dest
2305
2306 IF (.NOT. ASSOCIATED(siepmann_source)) RETURN
2307 IF (ASSOCIATED(siepmann_dest)) CALL pair_potential_siepmann_release(siepmann_dest)
2308 CALL pair_potential_siepmann_create(siepmann_dest)
2309 siepmann_dest%B = siepmann_source%B
2310 siepmann_dest%D = siepmann_source%D
2311 siepmann_dest%E = siepmann_source%E
2312 siepmann_dest%F = siepmann_source%F
2313 siepmann_dest%beta = siepmann_source%beta
2314 siepmann_dest%rcutsq = siepmann_source%rcutsq
2315 siepmann_dest%allow_oh_formation = siepmann_source%allow_oh_formation
2316 siepmann_dest%allow_h3o_formation = siepmann_source%allow_h3o_formation
2317 siepmann_dest%allow_o_formation = siepmann_source%allow_o_formation
2318
2319 END SUBROUTINE pair_potential_siepmann_copy
2320
2321! **************************************************************************************************
2322!> \brief Creates the Siepmann-Sprik potential type
2323!> (Siepmann and Sprik, J. Chem. Phys. 102(1) 511, 1995)
2324!> \param siepmann ...
2325! **************************************************************************************************
2326 SUBROUTINE pair_potential_siepmann_clean(siepmann)
2327 TYPE(siepmann_pot_type), POINTER :: siepmann
2328
2329 IF (.NOT. ASSOCIATED(siepmann)) RETURN
2330 siepmann%B = 0.0_dp
2331 siepmann%D = 0.0_dp
2332 siepmann%E = 0.0_dp
2333 siepmann%F = 0.0_dp
2334 siepmann%beta = 0.0_dp
2335 siepmann%rcutsq = 0.0_dp
2336 siepmann%allow_oh_formation = .false.
2337 siepmann%allow_h3o_formation = .false.
2338 siepmann%allow_o_formation = .false.
2339
2340 END SUBROUTINE pair_potential_siepmann_clean
2341
2342! **************************************************************************************************
2343!> \brief Destroys the Siepmann-Sprik potential
2344!> (Siepmann and Sprik, J. Chem. Phys. 102(1) 511, 1995)
2345!> \param siepmann ...
2346! **************************************************************************************************
2347 SUBROUTINE pair_potential_siepmann_release(siepmann)
2348 TYPE(siepmann_pot_type), POINTER :: siepmann
2349
2350 IF (ASSOCIATED(siepmann)) THEN
2351 DEALLOCATE (siepmann)
2352 END IF
2353 NULLIFY (siepmann)
2354 END SUBROUTINE pair_potential_siepmann_release
2355
2356! **************************************************************************************************
2357!> \brief Creates the GAL19 potential type
2358!> (??)
2359!> \param gal ...
2360! **************************************************************************************************
2361 SUBROUTINE pair_potential_gal_create(gal)
2362 TYPE(gal_pot_type), POINTER :: gal
2363
2364 cpassert(.NOT. ASSOCIATED(gal))
2365 ALLOCATE (gal)
2366 CALL pair_potential_gal_clean(gal)
2367 END SUBROUTINE pair_potential_gal_create
2368
2369! **************************************************************************************************
2370!> \brief Copy two GAL potential type
2371!> (??)
2372!> \param gal_source ...
2373!> \param gal_dest ...
2374! **************************************************************************************************
2375 SUBROUTINE pair_potential_gal_copy(gal_source, gal_dest)
2376 TYPE(gal_pot_type), POINTER :: gal_source, gal_dest
2377
2378 IF (.NOT. ASSOCIATED(gal_source)) RETURN
2379 IF (ASSOCIATED(gal_dest)) CALL pair_potential_gal_release(gal_dest)
2380 CALL pair_potential_gal_create(gal_dest)
2381 gal_dest%met1 = gal_source%met1
2382 gal_dest%met2 = gal_source%met2
2383 gal_dest%epsilon = gal_source%epsilon
2384 gal_dest%bxy = gal_source%bxy
2385 gal_dest%bz = gal_source%bz
2386 gal_dest%r1 = gal_source%r1
2387 gal_dest%r2 = gal_source%r2
2388 gal_dest%a1 = gal_source%a1
2389 gal_dest%a2 = gal_source%a2
2390 gal_dest%a3 = gal_source%a3
2391 gal_dest%a4 = gal_source%a4
2392 gal_dest%a = gal_source%a
2393 gal_dest%b = gal_source%b
2394 gal_dest%c = gal_source%c
2395 ALLOCATE (gal_dest%gcn(SIZE(gal_source%gcn)))
2396 gal_dest%gcn = gal_source%gcn
2397 gal_dest%express = gal_source%express
2398 gal_dest%rcutsq = gal_source%rcutsq
2399
2400 END SUBROUTINE pair_potential_gal_copy
2401
2402! **************************************************************************************************
2403!> \brief Creates the GAL19 potential type
2404!> (??)
2405!> \param gal ...
2406! **************************************************************************************************
2407 SUBROUTINE pair_potential_gal_clean(gal)
2408 TYPE(gal_pot_type), POINTER :: gal
2409
2410 IF (.NOT. ASSOCIATED(gal)) RETURN
2411 gal%epsilon = 0.0_dp
2412 gal%bxy = 0.0_dp
2413 gal%bz = 0.0_dp
2414 gal%r1 = 0.0_dp
2415 gal%r2 = 0.0_dp
2416 gal%a1 = 0.0_dp
2417 gal%a2 = 0.0_dp
2418 gal%a3 = 0.0_dp
2419 gal%a4 = 0.0_dp
2420 gal%a = 0.0_dp
2421 gal%b = 0.0_dp
2422 gal%c = 0.0_dp
2423 gal%rcutsq = 0.0_dp
2424 gal%express = .false.
2425
2426 END SUBROUTINE pair_potential_gal_clean
2427
2428! **************************************************************************************************
2429!> \brief Destroys the GAL19 potential
2430!> (??)
2431!> \param gal ...
2432! **************************************************************************************************
2433 SUBROUTINE pair_potential_gal_release(gal)
2434 TYPE(gal_pot_type), POINTER :: gal
2435
2436 IF (ASSOCIATED(gal)) THEN
2437 DEALLOCATE (gal%gcn)
2438 DEALLOCATE (gal)
2439 END IF
2440 NULLIFY (gal)
2441 END SUBROUTINE pair_potential_gal_release
2442
2443! **************************************************************************************************
2444!> \brief Creates the GAL21 potential type
2445!> (??)
2446!> \param gal21 ...
2447! **************************************************************************************************
2448 SUBROUTINE pair_potential_gal21_create(gal21)
2449 TYPE(gal21_pot_type), POINTER :: gal21
2450
2451 cpassert(.NOT. ASSOCIATED(gal21))
2452 ALLOCATE (gal21)
2453 CALL pair_potential_gal21_clean(gal21)
2454 END SUBROUTINE pair_potential_gal21_create
2455
2456! **************************************************************************************************
2457!> \brief Copy two GAL21 potential type
2458!> (??)
2459!> \param gal21_source ...
2460!> \param gal21_dest ...
2461! **************************************************************************************************
2462 SUBROUTINE pair_potential_gal21_copy(gal21_source, gal21_dest)
2463 TYPE(gal21_pot_type), POINTER :: gal21_source, gal21_dest
2464
2465 IF (.NOT. ASSOCIATED(gal21_source)) RETURN
2466 IF (ASSOCIATED(gal21_dest)) CALL pair_potential_gal21_release(gal21_dest)
2467 CALL pair_potential_gal21_create(gal21_dest)
2468 gal21_dest%met1 = gal21_source%met1
2469 gal21_dest%met2 = gal21_source%met2
2470 gal21_dest%epsilon1 = gal21_source%epsilon1
2471 gal21_dest%epsilon2 = gal21_source%epsilon2
2472 gal21_dest%epsilon3 = gal21_source%epsilon3
2473 gal21_dest%bxy1 = gal21_source%bxy1
2474 gal21_dest%bxy2 = gal21_source%bxy2
2475 gal21_dest%bz1 = gal21_source%bz1
2476 gal21_dest%bz2 = gal21_source%bz2
2477 gal21_dest%r1 = gal21_source%r1
2478 gal21_dest%r2 = gal21_source%r2
2479 gal21_dest%a11 = gal21_source%a11
2480 gal21_dest%a12 = gal21_source%a12
2481 gal21_dest%a13 = gal21_source%a13
2482 gal21_dest%a21 = gal21_source%a21
2483 gal21_dest%a22 = gal21_source%a22
2484 gal21_dest%a23 = gal21_source%a23
2485 gal21_dest%a31 = gal21_source%a31
2486 gal21_dest%a32 = gal21_source%a32
2487 gal21_dest%a33 = gal21_source%a33
2488 gal21_dest%a41 = gal21_source%a41
2489 gal21_dest%a42 = gal21_source%a42
2490 gal21_dest%a43 = gal21_source%a43
2491 gal21_dest%AO1 = gal21_source%AO1
2492 gal21_dest%AO2 = gal21_source%AO2
2493 gal21_dest%BO1 = gal21_source%BO1
2494 gal21_dest%BO2 = gal21_source%BO2
2495 gal21_dest%c = gal21_source%c
2496 gal21_dest%AH1 = gal21_source%AH1
2497 gal21_dest%AH2 = gal21_source%AH2
2498 gal21_dest%BH1 = gal21_source%BH1
2499 gal21_dest%BH2 = gal21_source%BH2
2500 ALLOCATE (gal21_dest%gcn(SIZE(gal21_source%gcn)))
2501 gal21_dest%gcn = gal21_source%gcn
2502 gal21_dest%express = gal21_source%express
2503 gal21_dest%rcutsq = gal21_source%rcutsq
2504
2505 END SUBROUTINE pair_potential_gal21_copy
2506
2507! **************************************************************************************************
2508!> \brief Creates the GAL21 potential type
2509!> (??)
2510!> \param gal21 ...
2511! **************************************************************************************************
2512 SUBROUTINE pair_potential_gal21_clean(gal21)
2513 TYPE(gal21_pot_type), POINTER :: gal21
2514
2515 IF (.NOT. ASSOCIATED(gal21)) RETURN
2516 gal21%epsilon1 = 0.0_dp
2517 gal21%epsilon2 = 0.0_dp
2518 gal21%epsilon3 = 0.0_dp
2519 gal21%bxy1 = 0.0_dp
2520 gal21%bxy2 = 0.0_dp
2521 gal21%bz1 = 0.0_dp
2522 gal21%bz2 = 0.0_dp
2523 gal21%r1 = 0.0_dp
2524 gal21%r2 = 0.0_dp
2525 gal21%a11 = 0.0_dp
2526 gal21%a12 = 0.0_dp
2527 gal21%a13 = 0.0_dp
2528 gal21%a21 = 0.0_dp
2529 gal21%a22 = 0.0_dp
2530 gal21%a23 = 0.0_dp
2531 gal21%a31 = 0.0_dp
2532 gal21%a32 = 0.0_dp
2533 gal21%a33 = 0.0_dp
2534 gal21%a41 = 0.0_dp
2535 gal21%a42 = 0.0_dp
2536 gal21%a43 = 0.0_dp
2537 gal21%AO1 = 0.0_dp
2538 gal21%AO2 = 0.0_dp
2539 gal21%BO1 = 0.0_dp
2540 gal21%BO2 = 0.0_dp
2541 gal21%c = 0.0_dp
2542 gal21%AH1 = 0.0_dp
2543 gal21%AH2 = 0.0_dp
2544 gal21%BH1 = 0.0_dp
2545 gal21%BH2 = 0.0_dp
2546 gal21%rcutsq = 0.0_dp
2547 gal21%express = .false.
2548
2549 END SUBROUTINE pair_potential_gal21_clean
2550
2551! **************************************************************************************************
2552!> \brief Destroys the GAL21 potential
2553!> (??)
2554!> \param gal21 ...
2555! **************************************************************************************************
2556 SUBROUTINE pair_potential_gal21_release(gal21)
2557 TYPE(gal21_pot_type), POINTER :: gal21
2558
2559 IF (ASSOCIATED(gal21)) THEN
2560 DEALLOCATE (gal21%gcn)
2561 DEALLOCATE (gal21)
2562 END IF
2563 NULLIFY (gal21)
2564 END SUBROUTINE pair_potential_gal21_release
2565
2566! **************************************************************************************************
2567!> \brief Creates the TABPOT potential type
2568!> \param tab ...
2569!> \author Alex Mironenko, Da Teng 2019-2022
2570! **************************************************************************************************
2571 SUBROUTINE pair_potential_tab_create(tab)
2572 TYPE(tab_pot_type), POINTER :: tab
2573
2574 cpassert(.NOT. ASSOCIATED(tab))
2575 ALLOCATE (tab)
2576 NULLIFY (tab%r, tab%e, tab%f)
2577 CALL pair_potential_tab_clean(tab)
2578 END SUBROUTINE pair_potential_tab_create
2579
2580! **************************************************************************************************
2581!> \brief Copy two TABPOT potential type
2582!> \param tab_source ...
2583!> \param tab_dest ...
2584! **************************************************************************************************
2585 SUBROUTINE pair_potential_tab_copy(tab_source, tab_dest)
2586 TYPE(tab_pot_type), POINTER :: tab_source, tab_dest
2587
2588 IF (.NOT. ASSOCIATED(tab_source)) RETURN
2589 IF (ASSOCIATED(tab_dest)) CALL pair_potential_tab_release(tab_dest)
2590 CALL pair_potential_tab_create(tab_dest)
2591 tab_dest%tabpot_file_name = tab_source%tabpot_file_name
2592 tab_dest%dr = tab_source%dr
2593 tab_dest%rcut = tab_source%rcut
2594 tab_dest%npoints = tab_source%npoints
2595 tab_dest%index = tab_source%index
2596 ! Allocate arrays with the proper size
2597 CALL reallocate(tab_dest%r, 1, tab_dest%npoints)
2598 CALL reallocate(tab_dest%e, 1, tab_dest%npoints)
2599 CALL reallocate(tab_dest%f, 1, tab_dest%npoints)
2600 tab_dest%r = tab_source%r
2601 tab_dest%e = tab_source%e
2602 tab_dest%f = tab_source%f
2603 END SUBROUTINE pair_potential_tab_copy
2604
2605! **************************************************************************************************
2606!> \brief Creates the TABPOT potential type
2607!> \param tab ...
2608! **************************************************************************************************
2609 SUBROUTINE pair_potential_tab_clean(tab)
2610 TYPE(tab_pot_type), POINTER :: tab
2611
2612 IF (.NOT. ASSOCIATED(tab)) RETURN
2613 tab%tabpot_file_name = 'NULL'
2614 tab%dr = 0.0_dp
2615 tab%rcut = 0.0_dp
2616 tab%npoints = 0
2617 tab%index = 0
2618 CALL reallocate(tab%r, 1, tab%npoints)
2619 CALL reallocate(tab%e, 1, tab%npoints)
2620 CALL reallocate(tab%f, 1, tab%npoints)
2621
2622 END SUBROUTINE pair_potential_tab_clean
2623
2624! **************************************************************************************************
2625!> \brief Destroys the TABPOT potential type
2626!> \param tab ...
2627! **************************************************************************************************
2628 SUBROUTINE pair_potential_tab_release(tab)
2629 TYPE(tab_pot_type), POINTER :: tab
2630
2631 IF (ASSOCIATED(tab)) THEN
2632 IF (ASSOCIATED(tab%r)) THEN
2633 DEALLOCATE (tab%r)
2634 END IF
2635 IF (ASSOCIATED(tab%e)) THEN
2636 DEALLOCATE (tab%e)
2637 END IF
2638 IF (ASSOCIATED(tab%f)) THEN
2639 DEALLOCATE (tab%f)
2640 END IF
2641 DEALLOCATE (tab)
2642 END IF
2643 END SUBROUTINE pair_potential_tab_release
2644
2645END MODULE pair_potential_types
2646
Interface to ACE C wrapper.
Definition ace_wrapper.F:12
Defines the basic variable types.
Definition kinds.F:23
integer, parameter, public dp
Definition kinds.F:34
integer, parameter, public default_string_length
Definition kinds.F:57
integer, parameter, public default_path_length
Definition kinds.F:58
Utility routines for the memory handling.
integer, parameter, public sh_sh
integer, parameter, public nosh_nosh
subroutine, public pair_potential_reallocate(p, lb1_new, ub1_new, lj, lj_charmm, williams, goodwin, eam, nequip, bmhft, bmhftd, ipbv, buck4r, buckmo, gp, tersoff, siepmann, gal, gal21, tab, deepmd, ace)
Cleans the potential parameter type.
integer, parameter, public lj_charmm_type
integer, parameter, public allegro_type
integer, parameter, public bm_type
integer, dimension(22), parameter, public list_pot
integer, parameter, public gal_type
subroutine, public pair_potential_pp_release(potparm)
Release Data-structure that constains potential parameters.
integer, parameter, public nequip_type
integer, parameter, public wl_type
integer, parameter, public ft_type
integer, parameter, public tab_type
integer, parameter, public ftd_type
integer, parameter, public ip_type
subroutine, public pair_potential_p_release(potparm)
Release Data-structure that constains potential parameters.
integer, parameter, public lj_type
integer, parameter, public deepmd_type
subroutine, public pair_potential_single_copy(potparm_source, potparm_dest)
Copy two potential parameter type.
integer, parameter, public nn_type
integer, parameter, public multi_type
integer, parameter, public gp_type
subroutine, public pair_potential_single_add(potparm_source, potparm_dest)
Add potential parameter type to an existing potential parameter type Used in case of multiple_potenti...
integer, parameter, public siepmann_type
integer, parameter, public nosh_sh
subroutine, public pair_potential_single_clean(potparm)
Cleans the potential parameter type.
subroutine, public pair_potential_lj_create(lj)
Cleans the LJ potential type.
integer, parameter, public ace_type
integer, dimension(2), parameter, public do_potential_single_allocation
subroutine, public compare_pot(pot1, pot2, compare)
compare two different potentials
integer, parameter, public gw_type
real(kind=dp), parameter, public not_initialized
subroutine, public pair_potential_pp_create(potparm, nkinds)
Data-structure that constains potential parameters.
integer, dimension(3), parameter, public list_sh_type
integer, dimension(2), parameter, public no_potential_single_allocation
integer, parameter, public mace_type
integer, parameter, public b4_type
integer, parameter, public gal21_type
integer, dimension(2), public potential_single_allocation
integer, parameter, public ea_type
integer, parameter, public tersoff_type
routines for handling splines_types
subroutine, public spline_data_p_copy(spl_p_source, spl_p_dest)
Copy Data-structure of spline_data_p_type.
subroutine, public spline_factor_release(spline_factor)
releases spline_factor
subroutine, public spline_data_p_release(spl_p)
releases spline_data_p
subroutine, public spline_factor_copy(spline_factor_source, spline_factor_dest)
releases spline_factor