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