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