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