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