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 : !> \brief Definition of the semi empirical parameter types.
10 : !> \author JGH (14.08.2004)
11 : ! **************************************************************************************************
12 : MODULE semi_empirical_types
13 : USE basis_set_types, ONLY: deallocate_sto_basis_set,&
14 : sto_basis_set_type
15 : USE cp_log_handling, ONLY: cp_get_default_logger,&
16 : cp_logger_type,&
17 : cp_to_string
18 : USE cp_output_handling, ONLY: cp_p_file,&
19 : cp_print_key_finished_output,&
20 : cp_print_key_should_output,&
21 : cp_print_key_unit_nr
22 : USE dg_types, ONLY: dg_type
23 : USE input_constants, ONLY: &
24 : do_method_am1, do_method_mndo, do_method_mndod, do_method_pdg, do_method_pm3, &
25 : do_method_pm6, do_method_pm6fm, do_method_pnnl, do_method_rm1, do_se_IS_kdso_d, &
26 : do_se_IS_slater
27 : USE input_section_types, ONLY: section_vals_type
28 : USE kinds, ONLY: default_string_length,&
29 : dp
30 : USE multipole_types, ONLY: do_multipole_charge,&
31 : do_multipole_dipole,&
32 : do_multipole_none,&
33 : do_multipole_quadrupole
34 : USE physcon, ONLY: angstrom,&
35 : evolt,&
36 : kcalmol
37 : USE pw_pool_types, ONLY: pw_pool_type
38 : USE semi_empirical_expns3_types, ONLY: semi_empirical_expns3_p_type,&
39 : semi_empirical_expns3_release
40 : USE semi_empirical_mpole_types, ONLY: semi_empirical_mpole_p_release,&
41 : semi_empirical_mpole_p_type
42 : USE taper_types, ONLY: taper_create,&
43 : taper_release,&
44 : taper_type
45 : #include "./base/base_uses.f90"
46 :
47 : IMPLICIT NONE
48 :
49 : PRIVATE
50 :
51 : ! *** Global parameters ***
52 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'semi_empirical_types'
53 :
54 : ! **************************************************************************************************
55 : !> \brief Semi-empirical type
56 : ! **************************************************************************************************
57 : TYPE semi_empirical_type
58 : INTEGER :: typ = -1
59 : INTEGER :: nr = -1
60 : INTEGER :: core_size = -1, atm_int_size = -1
61 : CHARACTER(LEN=default_string_length) :: name = ""
62 : LOGICAL :: defined = .FALSE., dorb = .FALSE., extended_basis_set = .FALSE.
63 : LOGICAL :: p_orbitals_on_h = .FALSE.
64 : INTEGER :: z = -1
65 : REAL(KIND=dp) :: zeff = -1.0_dp
66 : INTEGER :: natorb = -1
67 : REAL(KIND=dp), DIMENSION(:), POINTER :: beta => NULL()
68 : REAL(KIND=dp), DIMENSION(:), POINTER :: sto_exponents => NULL()
69 : REAL(KIND=dp), DIMENSION(:), POINTER :: zn => NULL()
70 : TYPE(sto_basis_set_type), POINTER :: basis => NULL()
71 : INTEGER :: ngauss = -1
72 : REAL(KIND=dp) :: eheat = -1.0_dp
73 : REAL(KIND=dp) :: uss = -1.0_dp, upp = -1.0_dp, udd = -1.0_dp, uff = -1.0_dp
74 : REAL(KIND=dp) :: alp = -1.0_dp
75 : REAL(KIND=dp) :: eisol = -1.0_dp
76 : REAL(KIND=dp) :: ass = -1.0_dp, asp = -1.0_dp, app = -1.0_dp, de = -1.0_dp, acoul = -1.0_dp
77 : REAL(KIND=dp) :: gss = -1.0_dp, gsp = -1.0_dp, gpp = -1.0_dp, gp2 = -1.0_dp
78 : REAL(KIND=dp) :: gsd = -1.0_dp, gpd = -1.0_dp, gdd = -1.0_dp
79 : REAL(KIND=dp) :: hsp = -1.0_dp
80 : REAL(KIND=dp) :: dd = -1.0_dp, qq = -1.0_dp, am = -1.0_dp, ad = -1.0_dp, aq = -1.0_dp
81 : REAL(KIND=dp), DIMENSION(2) :: pre = -1.0_dp, d = -1.0_dp
82 : REAL(KIND=dp), DIMENSION(4) :: fn1 = -1.0_dp, fn2 = -1.0_dp, fn3 = -1.0_dp
83 : REAL(KIND=dp), DIMENSION(4, 4) :: bfn1 = -1.0_dp, bfn2 = -1.0_dp, bfn3 = -1.0_dp
84 : REAL(KIND=dp) :: f0dd = -1.0_dp, f2dd = -1.0_dp, f4dd = -1.0_dp, &
85 : f0sd = -1.0_dp, f0pd = -1.0_dp, f2pd = -1.0_dp, &
86 : g1pd = -1.0_dp, g2sd = -1.0_dp, g3pd = -1.0_dp
87 : REAL(KIND=dp), DIMENSION(9) :: ko = -1.0_dp
88 : REAL(KIND=dp), DIMENSION(6) :: cs = -1.0_dp
89 : REAL(KIND=dp), DIMENSION(52) :: onec2el = -1.0_dp
90 : ! Specific for PM6 & PM6-FM
91 : REAL(KIND=dp), DIMENSION(0:115) :: xab = -1.0_dp
92 : REAL(KIND=dp), DIMENSION(0:115) :: aab = -1.0_dp
93 : REAL(KIND=dp) :: a = -1.0_dp, b = -1.0_dp, c = -1.0_dp, rho = -1.0_dp
94 : ! One center - two electron integrals
95 : REAL(KIND=dp), DIMENSION(:, :), &
96 : POINTER :: w => NULL()
97 : TYPE(semi_empirical_mpole_p_type), &
98 : POINTER, DIMENSION(:) :: w_mpole => NULL()
99 : ! 1/R^3 residual integral part
100 : TYPE(semi_empirical_expns3_p_type), &
101 : POINTER, DIMENSION(:) :: expns3_int => NULL()
102 : END TYPE semi_empirical_type
103 :
104 : TYPE semi_empirical_p_type
105 : TYPE(semi_empirical_type), POINTER :: se_param => NULL()
106 : END TYPE semi_empirical_p_type
107 :
108 : ! **************************************************************************************************
109 : !> \brief Rotation Matrix Type
110 : !> \author 05.2008 Teodoro Laino [tlaino] - University of Zurich
111 : ! **************************************************************************************************
112 : TYPE rotmat_type
113 : ! Value of Rotation Matrices
114 : REAL(KIND=dp), DIMENSION(3, 3) :: sp = -1.0_dp
115 : REAL(KIND=dp), DIMENSION(5, 5) :: sd = -1.0_dp
116 : REAL(KIND=dp), DIMENSION(6, 3, 3) :: pp = -1.0_dp
117 : REAL(KIND=dp), DIMENSION(15, 5, 3) :: pd = -1.0_dp
118 : REAL(KIND=dp), DIMENSION(15, 5, 5) :: dd = -1.0_dp
119 : ! Derivatives of Rotation Matrices
120 : REAL(KIND=dp), DIMENSION(3, 3, 3) :: sp_d = -1.0_dp
121 : REAL(KIND=dp), DIMENSION(3, 5, 5) :: sd_d = -1.0_dp
122 : REAL(KIND=dp), DIMENSION(3, 6, 3, 3) :: pp_d = -1.0_dp
123 : REAL(KIND=dp), DIMENSION(3, 15, 5, 3) :: pd_d = -1.0_dp
124 : REAL(KIND=dp), DIMENSION(3, 15, 5, 5) :: dd_d = -1.0_dp
125 : END TYPE rotmat_type
126 :
127 : ! **************************************************************************************************
128 : !> \brief Ewald control type (for periodic SE)
129 : !> \author Teodoro Laino [tlaino] - 12.2008
130 : ! **************************************************************************************************
131 : TYPE ewald_gks_type
132 : REAL(KIND=dp) :: alpha = -1.0_dp
133 : TYPE(dg_type), POINTER :: dg => NULL()
134 : TYPE(pw_pool_type), POINTER :: pw_pool => NULL()
135 : END TYPE ewald_gks_type
136 :
137 : TYPE se_int_control_type
138 : LOGICAL :: shortrange = .FALSE.
139 : LOGICAL :: do_ewald_r3 = .FALSE.
140 : LOGICAL :: do_ewald_gks = .FALSE.
141 : LOGICAL :: pc_coulomb_int = .FALSE.
142 : INTEGER :: integral_screening = -1
143 : INTEGER :: max_multipole = -1
144 : TYPE(ewald_gks_type) :: ewald_gks = ewald_gks_type()
145 : END TYPE se_int_control_type
146 :
147 : ! **************************************************************************************************
148 : !> \brief Store the value of the tapering function and possibly its derivative
149 : !> for screened integrals
150 : ! **************************************************************************************************
151 : TYPE se_int_screen_type
152 : REAL(KIND=dp) :: ft = -1.0_dp, dft = -1.0_dp
153 : END TYPE se_int_screen_type
154 :
155 : ! **************************************************************************************************
156 : !> \brief Taper type use in semi-empirical calculations
157 : ! **************************************************************************************************
158 : TYPE se_taper_type
159 : TYPE(taper_type), POINTER :: taper => NULL()
160 : TYPE(taper_type), POINTER :: taper_cou => NULL()
161 : TYPE(taper_type), POINTER :: taper_exc => NULL()
162 : TYPE(taper_type), POINTER :: taper_lrc => NULL()
163 : ! This taper is for KDSO-D integrals
164 : TYPE(taper_type), POINTER :: taper_add => NULL()
165 : END TYPE se_taper_type
166 :
167 : PUBLIC :: semi_empirical_type, &
168 : semi_empirical_p_type, &
169 : semi_empirical_create, &
170 : semi_empirical_release, &
171 : rotmat_type, &
172 : rotmat_create, &
173 : rotmat_release, &
174 : get_se_param, &
175 : write_se_param, &
176 : se_int_control_type, &
177 : setup_se_int_control_type, &
178 : se_int_screen_type, &
179 : se_taper_type, &
180 : se_taper_release, &
181 : se_taper_create
182 :
183 : CONTAINS
184 :
185 : ! **************************************************************************************************
186 : !> \brief Allocate semi-empirical type
187 : !> \param sep ...
188 : ! **************************************************************************************************
189 3964 : SUBROUTINE semi_empirical_create(sep)
190 : TYPE(semi_empirical_type), POINTER :: sep
191 :
192 3964 : CPASSERT(.NOT. ASSOCIATED(sep))
193 1538032 : ALLOCATE (sep)
194 3964 : ALLOCATE (sep%beta(0:3))
195 3964 : ALLOCATE (sep%sto_exponents(0:3))
196 3964 : ALLOCATE (sep%zn(0:3))
197 : NULLIFY (sep%basis)
198 : NULLIFY (sep%w)
199 : NULLIFY (sep%w_mpole)
200 : NULLIFY (sep%expns3_int)
201 3964 : CALL zero_se_param(sep)
202 :
203 3964 : END SUBROUTINE semi_empirical_create
204 :
205 : ! **************************************************************************************************
206 : !> \brief Deallocate the semi-empirical type
207 : !> \param sep ...
208 : ! **************************************************************************************************
209 3964 : SUBROUTINE semi_empirical_release(sep)
210 :
211 : TYPE(semi_empirical_type), POINTER :: sep
212 :
213 : INTEGER :: i
214 :
215 3964 : IF (ASSOCIATED(sep)) THEN
216 3964 : CALL deallocate_sto_basis_set(sep%basis)
217 3964 : CALL semi_empirical_mpole_p_release(sep%w_mpole)
218 3964 : IF (ASSOCIATED(sep%beta)) THEN
219 3964 : DEALLOCATE (sep%beta)
220 : END IF
221 3964 : IF (ASSOCIATED(sep%sto_exponents)) THEN
222 3964 : DEALLOCATE (sep%sto_exponents)
223 : END IF
224 3964 : IF (ASSOCIATED(sep%zn)) THEN
225 3964 : DEALLOCATE (sep%zn)
226 : END IF
227 3964 : IF (ASSOCIATED(sep%w)) THEN
228 3964 : DEALLOCATE (sep%w)
229 : END IF
230 3964 : IF (ASSOCIATED(sep%expns3_int)) THEN
231 0 : DO i = 1, SIZE(sep%expns3_int)
232 0 : CALL semi_empirical_expns3_release(sep%expns3_int(i)%expns3)
233 : END DO
234 0 : DEALLOCATE (sep%expns3_int)
235 : END IF
236 3964 : DEALLOCATE (sep)
237 : END IF
238 :
239 3964 : END SUBROUTINE semi_empirical_release
240 :
241 : ! **************************************************************************************************
242 : !> \brief Zero the whole semi-empirical type
243 : !> \param sep ...
244 : ! **************************************************************************************************
245 3964 : SUBROUTINE zero_se_param(sep)
246 : TYPE(semi_empirical_type), POINTER :: sep
247 :
248 3964 : CPASSERT(ASSOCIATED(sep))
249 3964 : sep%defined = .FALSE.
250 3964 : sep%dorb = .FALSE.
251 3964 : sep%extended_basis_set = .FALSE.
252 3964 : sep%p_orbitals_on_h = .FALSE.
253 3964 : sep%name = ""
254 3964 : sep%typ = HUGE(0)
255 3964 : sep%core_size = HUGE(0)
256 3964 : sep%atm_int_size = HUGE(0)
257 3964 : sep%z = HUGE(0)
258 3964 : sep%zeff = HUGE(0.0_dp)
259 3964 : sep%natorb = 0
260 3964 : sep%ngauss = 0
261 3964 : sep%eheat = HUGE(0.0_dp)
262 :
263 19820 : sep%zn = 0.0_dp
264 19820 : sep%sto_exponents = 0.0_dp
265 19820 : sep%beta = 0.0_dp
266 :
267 3964 : sep%uss = 0.0_dp !eV
268 3964 : sep%upp = 0.0_dp !eV
269 3964 : sep%udd = 0.0_dp !eV
270 3964 : sep%uff = 0.0_dp
271 3964 : sep%alp = 0.0_dp
272 3964 : sep%eisol = 0.0_dp
273 3964 : sep%nr = 1
274 3964 : sep%acoul = 0.0_dp
275 3964 : sep%de = 0.0_dp
276 3964 : sep%ass = 0.0_dp
277 3964 : sep%asp = 0.0_dp
278 3964 : sep%app = 0.0_dp
279 3964 : sep%gss = 0.0_dp
280 3964 : sep%gsp = 0.0_dp
281 3964 : sep%gpp = 0.0_dp
282 3964 : sep%gp2 = 0.0_dp
283 3964 : sep%gsd = 0.0_dp
284 3964 : sep%gpd = 0.0_dp
285 3964 : sep%gdd = 0.0_dp
286 3964 : sep%hsp = 0.0_dp
287 3964 : sep%dd = 0.0_dp
288 3964 : sep%qq = 0.0_dp
289 3964 : sep%am = 0.0_dp
290 3964 : sep%ad = 0.0_dp
291 3964 : sep%aq = 0.0_dp
292 :
293 19820 : sep%fn1 = 0.0_dp
294 19820 : sep%fn2 = 0.0_dp
295 19820 : sep%fn3 = 0.0_dp
296 83244 : sep%bfn1 = 0.0_dp
297 83244 : sep%bfn2 = 0.0_dp
298 83244 : sep%bfn3 = 0.0_dp
299 :
300 11892 : sep%pre = 0.0_dp
301 11892 : sep%d = 0.0_dp
302 :
303 463788 : sep%xab = 0.0_dp
304 463788 : sep%aab = 0.0_dp
305 3964 : sep%a = 0.0_dp
306 3964 : sep%b = 0.0_dp
307 3964 : sep%c = 0.0_dp
308 3964 : sep%rho = 0.0_dp
309 :
310 3964 : sep%f0dd = 0.0_dp
311 3964 : sep%f2dd = 0.0_dp
312 3964 : sep%f4dd = 0.0_dp
313 3964 : sep%f0sd = 0.0_dp
314 3964 : sep%f0pd = 0.0_dp
315 3964 : sep%f2pd = 0.0_dp
316 3964 : sep%g1pd = 0.0_dp
317 3964 : sep%g2sd = 0.0_dp
318 3964 : sep%g3pd = 0.0_dp
319 39640 : sep%ko = 0.0_dp
320 27748 : sep%cs = 0.0_dp
321 210092 : sep%onec2el = 0.0_dp
322 :
323 3964 : END SUBROUTINE zero_se_param
324 :
325 : ! **************************************************************************************************
326 : !> \brief Get info from the semi-empirical type
327 : !> \param sep ...
328 : !> \param name ...
329 : !> \param typ ...
330 : !> \param defined ...
331 : !> \param z ...
332 : !> \param zeff ...
333 : !> \param natorb ...
334 : !> \param eheat ...
335 : !> \param beta ...
336 : !> \param sto_exponents ...
337 : !> \param uss ...
338 : !> \param upp ...
339 : !> \param udd ...
340 : !> \param uff ...
341 : !> \param alp ...
342 : !> \param eisol ...
343 : !> \param gss ...
344 : !> \param gsp ...
345 : !> \param gpp ...
346 : !> \param gp2 ...
347 : !> \param acoul ...
348 : !> \param nr ...
349 : !> \param de ...
350 : !> \param ass ...
351 : !> \param asp ...
352 : !> \param app ...
353 : !> \param hsp ...
354 : !> \param gsd ...
355 : !> \param gpd ...
356 : !> \param gdd ...
357 : !> \param ppddg ...
358 : !> \param dpddg ...
359 : !> \param ngauss ...
360 : ! **************************************************************************************************
361 251315 : SUBROUTINE get_se_param(sep, name, typ, defined, z, zeff, natorb, eheat, &
362 : beta, sto_exponents, uss, upp, udd, uff, alp, eisol, gss, gsp, gpp, gp2, &
363 : acoul, nr, de, ass, asp, app, hsp, gsd, gpd, gdd, ppddg, dpddg, ngauss)
364 :
365 : TYPE(semi_empirical_type), POINTER :: sep
366 : CHARACTER(LEN=default_string_length), &
367 : INTENT(OUT), OPTIONAL :: name
368 : INTEGER, INTENT(OUT), OPTIONAL :: typ
369 : LOGICAL, INTENT(OUT), OPTIONAL :: defined
370 : INTEGER, INTENT(OUT), OPTIONAL :: z
371 : REAL(KIND=dp), INTENT(OUT), OPTIONAL :: zeff
372 : INTEGER, INTENT(OUT), OPTIONAL :: natorb
373 : REAL(KIND=dp), OPTIONAL :: eheat
374 : REAL(KIND=dp), DIMENSION(:), OPTIONAL, POINTER :: beta, sto_exponents
375 : REAL(KIND=dp), OPTIONAL :: uss, upp, udd, uff, alp, eisol, gss, &
376 : gsp, gpp, gp2, acoul
377 : INTEGER, INTENT(OUT), OPTIONAL :: nr
378 : REAL(KIND=dp), OPTIONAL :: de, ass, asp, app, hsp, gsd, gpd, gdd
379 : REAL(KIND=dp), DIMENSION(2), OPTIONAL :: ppddg, dpddg
380 : INTEGER, INTENT(OUT), OPTIONAL :: ngauss
381 :
382 251315 : IF (ASSOCIATED(sep)) THEN
383 251315 : IF (PRESENT(name)) name = sep%name
384 251315 : IF (PRESENT(typ)) typ = sep%typ
385 251315 : IF (PRESENT(defined)) defined = sep%defined
386 251315 : IF (PRESENT(z)) z = sep%z
387 251315 : IF (PRESENT(zeff)) zeff = sep%zeff
388 251315 : IF (PRESENT(natorb)) natorb = sep%natorb
389 251315 : IF (PRESENT(eheat)) eheat = sep%eheat
390 251315 : IF (PRESENT(beta)) beta => sep%beta
391 251315 : IF (PRESENT(sto_exponents)) sto_exponents => sep%sto_exponents
392 251315 : IF (PRESENT(ngauss)) ngauss = sep%ngauss
393 251315 : IF (PRESENT(uss)) uss = sep%uss
394 251315 : IF (PRESENT(upp)) upp = sep%upp
395 251315 : IF (PRESENT(udd)) udd = sep%udd
396 251315 : IF (PRESENT(uff)) uff = sep%uff
397 251315 : IF (PRESENT(alp)) alp = sep%alp
398 251315 : IF (PRESENT(eisol)) eisol = sep%eisol
399 251315 : IF (PRESENT(nr)) nr = sep%nr
400 251315 : IF (PRESENT(acoul)) acoul = sep%acoul
401 251315 : IF (PRESENT(de)) de = sep%de
402 251315 : IF (PRESENT(ass)) ass = sep%ass
403 251315 : IF (PRESENT(asp)) asp = sep%asp
404 251315 : IF (PRESENT(app)) app = sep%app
405 251315 : IF (PRESENT(gss)) gss = sep%gss
406 251315 : IF (PRESENT(gsp)) gsp = sep%gsp
407 251315 : IF (PRESENT(gpp)) gpp = sep%gpp
408 251315 : IF (PRESENT(gp2)) gp2 = sep%gp2
409 251315 : IF (PRESENT(hsp)) hsp = sep%hsp
410 251315 : IF (PRESENT(gsd)) gsd = sep%gsd
411 251315 : IF (PRESENT(gpd)) gpd = sep%gpd
412 251315 : IF (PRESENT(gdd)) gdd = sep%gdd
413 251393 : IF (PRESENT(ppddg)) ppddg = sep%pre
414 251393 : IF (PRESENT(dpddg)) dpddg = sep%d
415 : ELSE
416 0 : CPABORT("The pointer sep is not associated")
417 : END IF
418 :
419 251315 : END SUBROUTINE get_se_param
420 :
421 : ! **************************************************************************************************
422 : !> \brief Set info from the semi-empirical type
423 : !> \param sep ...
424 : !> \param name ...
425 : !> \param typ ...
426 : !> \param defined ...
427 : !> \param z ...
428 : !> \param zeff ...
429 : !> \param natorb ...
430 : !> \param eheat ...
431 : !> \param beta ...
432 : !> \param sto_exponents ...
433 : !> \param uss ...
434 : !> \param upp ...
435 : !> \param udd ...
436 : !> \param uff ...
437 : !> \param alp ...
438 : !> \param eisol ...
439 : !> \param gss ...
440 : !> \param gsp ...
441 : !> \param gpp ...
442 : !> \param gp2 ...
443 : !> \param acoul ...
444 : !> \param nr ...
445 : !> \param de ...
446 : !> \param ass ...
447 : !> \param asp ...
448 : !> \param app ...
449 : !> \param hsp ...
450 : !> \param gsd ...
451 : !> \param gpd ...
452 : !> \param gdd ...
453 : !> \param ppddg ...
454 : !> \param dpddg ...
455 : !> \param ngauss ...
456 : ! **************************************************************************************************
457 0 : SUBROUTINE set_se_param(sep, name, typ, defined, z, zeff, natorb, eheat, &
458 0 : beta, sto_exponents, uss, upp, udd, uff, alp, eisol, gss, gsp, gpp, gp2, &
459 : acoul, nr, de, ass, asp, app, hsp, gsd, gpd, gdd, ppddg, dpddg, ngauss)
460 :
461 : TYPE(semi_empirical_type), POINTER :: sep
462 : CHARACTER(LEN=default_string_length), INTENT(IN), &
463 : OPTIONAL :: name
464 : INTEGER, INTENT(IN), OPTIONAL :: typ
465 : LOGICAL, INTENT(IN), OPTIONAL :: defined
466 : INTEGER, INTENT(IN), OPTIONAL :: z
467 : REAL(KIND=dp), INTENT(IN), OPTIONAL :: zeff
468 : INTEGER, INTENT(IN), OPTIONAL :: natorb
469 : REAL(KIND=dp), OPTIONAL :: eheat
470 : REAL(dp), DIMENSION(0:), OPTIONAL :: beta
471 : REAL(KIND=dp), DIMENSION(:), OPTIONAL :: sto_exponents
472 : REAL(KIND=dp), OPTIONAL :: uss, upp, udd, uff, alp, eisol, gss, &
473 : gsp, gpp, gp2, acoul
474 : INTEGER, INTENT(IN), OPTIONAL :: nr
475 : REAL(KIND=dp), OPTIONAL :: de, ass, asp, app, hsp, gsd, gpd, gdd
476 : REAL(dp), DIMENSION(2), OPTIONAL :: ppddg, dpddg
477 : INTEGER, INTENT(IN), OPTIONAL :: ngauss
478 :
479 0 : IF (ASSOCIATED(sep)) THEN
480 0 : IF (PRESENT(name)) sep%name = name
481 0 : IF (PRESENT(typ)) sep%typ = typ
482 0 : IF (PRESENT(defined)) sep%defined = defined
483 0 : IF (PRESENT(z)) sep%z = z
484 0 : IF (PRESENT(zeff)) sep%zeff = zeff
485 0 : IF (PRESENT(natorb)) sep%natorb = natorb
486 0 : IF (PRESENT(eheat)) sep%eheat = eheat
487 0 : IF (PRESENT(beta)) sep%beta = beta
488 0 : IF (PRESENT(sto_exponents)) sep%sto_exponents = sto_exponents
489 0 : IF (PRESENT(ngauss)) sep%ngauss = ngauss
490 0 : IF (PRESENT(uss)) sep%uss = uss
491 0 : IF (PRESENT(upp)) sep%upp = upp
492 0 : IF (PRESENT(udd)) sep%udd = udd
493 0 : IF (PRESENT(uff)) sep%uff = uff
494 0 : IF (PRESENT(alp)) sep%alp = alp
495 0 : IF (PRESENT(eisol)) sep%eisol = eisol
496 0 : IF (PRESENT(acoul)) sep%acoul = acoul
497 0 : IF (PRESENT(nr)) sep%nr = nr
498 0 : IF (PRESENT(de)) sep%de = de
499 0 : IF (PRESENT(ass)) sep%ass = ass
500 0 : IF (PRESENT(asp)) sep%asp = asp
501 0 : IF (PRESENT(app)) sep%app = app
502 0 : IF (PRESENT(gss)) sep%gss = gss
503 0 : IF (PRESENT(gsp)) sep%gsp = gsp
504 0 : IF (PRESENT(gpp)) sep%gpp = gpp
505 0 : IF (PRESENT(gp2)) sep%gp2 = gp2
506 0 : IF (PRESENT(hsp)) sep%hsp = hsp
507 0 : IF (PRESENT(gsd)) sep%gsd = gsd
508 0 : IF (PRESENT(gpd)) sep%gpd = gpd
509 0 : IF (PRESENT(gdd)) sep%gdd = gdd
510 0 : IF (PRESENT(ppddg)) sep%pre = ppddg
511 0 : IF (PRESENT(dpddg)) sep%d = dpddg
512 : ELSE
513 0 : CPABORT("The pointer sep is not associated")
514 : END IF
515 :
516 0 : END SUBROUTINE set_se_param
517 :
518 : ! **************************************************************************************************
519 : !> \brief Creates rotmat type
520 : !> \param rotmat ...
521 : ! **************************************************************************************************
522 17364991 : SUBROUTINE rotmat_create(rotmat)
523 : TYPE(rotmat_type), POINTER :: rotmat
524 :
525 17364991 : CPASSERT(.NOT. ASSOCIATED(rotmat))
526 62288222717 : ALLOCATE (rotmat)
527 :
528 17364991 : END SUBROUTINE rotmat_create
529 :
530 : ! **************************************************************************************************
531 : !> \brief Releases rotmat type
532 : !> \param rotmat ...
533 : ! **************************************************************************************************
534 17364991 : SUBROUTINE rotmat_release(rotmat)
535 : TYPE(rotmat_type), POINTER :: rotmat
536 :
537 17364991 : IF (ASSOCIATED(rotmat)) THEN
538 17364991 : DEALLOCATE (rotmat)
539 : END IF
540 :
541 17364991 : END SUBROUTINE rotmat_release
542 :
543 : ! **************************************************************************************************
544 : !> \brief Setup the Semiempirical integral control type
545 : !> \param se_int_control ...
546 : !> \param shortrange ...
547 : !> \param do_ewald_r3 ...
548 : !> \param do_ewald_gks ...
549 : !> \param integral_screening ...
550 : !> \param max_multipole ...
551 : !> \param pc_coulomb_int ...
552 : !> \author Teodoro Laino [tlaino] - 12.2008
553 : ! **************************************************************************************************
554 24887275 : SUBROUTINE setup_se_int_control_type(se_int_control, shortrange, do_ewald_r3, &
555 : do_ewald_gks, integral_screening, max_multipole, pc_coulomb_int)
556 : TYPE(se_int_control_type) :: se_int_control
557 : LOGICAL, INTENT(IN) :: shortrange, do_ewald_r3, do_ewald_gks
558 : INTEGER, INTENT(IN) :: integral_screening, max_multipole
559 : LOGICAL, INTENT(IN) :: pc_coulomb_int
560 :
561 24887275 : se_int_control%shortrange = shortrange
562 24887275 : se_int_control%do_ewald_r3 = do_ewald_r3
563 24887275 : se_int_control%integral_screening = integral_screening
564 : ! This makes the assignment independent of the value of the different constants
565 49772198 : SELECT CASE (max_multipole)
566 : CASE (do_multipole_none)
567 24884923 : se_int_control%max_multipole = -1
568 : CASE (do_multipole_charge)
569 0 : se_int_control%max_multipole = 0
570 : CASE (do_multipole_dipole)
571 0 : se_int_control%max_multipole = 1
572 : CASE (do_multipole_quadrupole)
573 24887275 : se_int_control%max_multipole = 2
574 : END SELECT
575 :
576 24887275 : se_int_control%do_ewald_gks = do_ewald_gks
577 24887275 : se_int_control%pc_coulomb_int = pc_coulomb_int
578 24887275 : NULLIFY (se_int_control%ewald_gks%dg, se_int_control%ewald_gks%pw_pool)
579 :
580 24887275 : END SUBROUTINE setup_se_int_control_type
581 :
582 : ! **************************************************************************************************
583 : !> \brief Creates the taper type used in SE calculations
584 : !> \param se_taper ...
585 : !> \param integral_screening ...
586 : !> \param do_ewald ...
587 : !> \param taper_cou ...
588 : !> \param range_cou ...
589 : !> \param taper_exc ...
590 : !> \param range_exc ...
591 : !> \param taper_scr ...
592 : !> \param range_scr ...
593 : !> \param taper_lrc ...
594 : !> \param range_lrc ...
595 : !> \author Teodoro Laino [tlaino] - 03.2009
596 : ! **************************************************************************************************
597 998 : SUBROUTINE se_taper_create(se_taper, integral_screening, do_ewald, &
598 : taper_cou, range_cou, taper_exc, range_exc, taper_scr, range_scr, &
599 : taper_lrc, range_lrc)
600 : TYPE(se_taper_type), POINTER :: se_taper
601 : INTEGER, INTENT(IN) :: integral_screening
602 : LOGICAL, INTENT(IN) :: do_ewald
603 : REAL(KIND=dp), INTENT(IN) :: taper_cou, range_cou, taper_exc, &
604 : range_exc, taper_scr, range_scr, &
605 : taper_lrc, range_lrc
606 :
607 998 : CPASSERT(.NOT. ASSOCIATED(se_taper))
608 998 : ALLOCATE (se_taper)
609 : NULLIFY (se_taper%taper)
610 : NULLIFY (se_taper%taper_cou)
611 : NULLIFY (se_taper%taper_exc)
612 : NULLIFY (se_taper%taper_lrc)
613 : NULLIFY (se_taper%taper_add)
614 : ! Create the sub-typo taper
615 998 : CALL taper_create(se_taper%taper_cou, taper_cou, range_cou)
616 998 : CALL taper_create(se_taper%taper_exc, taper_exc, range_exc)
617 998 : IF (integral_screening == do_se_IS_kdso_d) THEN
618 14 : CALL taper_create(se_taper%taper_add, taper_scr, range_scr)
619 : END IF
620 998 : IF ((integral_screening /= do_se_IS_slater) .AND. do_ewald) THEN
621 20 : CALL taper_create(se_taper%taper_lrc, taper_lrc, range_lrc)
622 : END IF
623 998 : END SUBROUTINE se_taper_create
624 :
625 : ! **************************************************************************************************
626 : !> \brief Releases the taper type used in SE calculations
627 : !> \param se_taper ...
628 : !> \author Teodoro Laino [tlaino] - 03.2009
629 : ! **************************************************************************************************
630 1996 : SUBROUTINE se_taper_release(se_taper)
631 : TYPE(se_taper_type), POINTER :: se_taper
632 :
633 1996 : IF (ASSOCIATED(se_taper)) THEN
634 998 : CALL taper_release(se_taper%taper_cou)
635 998 : CALL taper_release(se_taper%taper_exc)
636 998 : CALL taper_release(se_taper%taper_lrc)
637 998 : CALL taper_release(se_taper%taper_add)
638 :
639 998 : DEALLOCATE (se_taper)
640 : END IF
641 1996 : END SUBROUTINE se_taper_release
642 :
643 : ! **************************************************************************************************
644 : !> \brief Writes the semi-empirical type
645 : !> \param sep ...
646 : !> \param subsys_section ...
647 : !> \par History
648 : !> 04.2008 Teodoro Laino [tlaino] - University of Zurich: rewriting with
649 : !> support for the whole set of parameters
650 : ! **************************************************************************************************
651 2240 : SUBROUTINE write_se_param(sep, subsys_section)
652 :
653 : TYPE(semi_empirical_type), POINTER :: sep
654 : TYPE(section_vals_type), POINTER :: subsys_section
655 :
656 : CHARACTER(LEN=1), DIMENSION(0:3), PARAMETER :: orb_lab = (/"S", "P", "D", "F"/)
657 : CHARACTER(LEN=2), DIMENSION(0:3), PARAMETER :: z_lab = (/"ZS", "ZP", "ZD", "ZF"/)
658 : CHARACTER(LEN=3), DIMENSION(0:3), PARAMETER :: zeta_lab = (/"ZSN", "ZPN", "ZDN", "ZFN"/)
659 : CHARACTER(LEN=5), DIMENSION(0:3), PARAMETER :: &
660 : beta_lab = (/"BETAS", "BETAP", "BETAD", "BETAF"/)
661 : CHARACTER(LEN=default_string_length) :: i_string, name
662 : INTEGER :: i, l, natorb, ngauss, nr, output_unit, &
663 : typ, z
664 : LOGICAL :: defined
665 : REAL(KIND=dp) :: acoul, alp, app, asp, ass, de, eheat, &
666 : eisol, gp2, gpp, gsp, gss, hsp, udd, &
667 : uff, upp, uss, zeff
668 : CHARACTER(LEN=3), DIMENSION(0:3), PARAMETER :: u_lab = (/"USS", "UPP", "UDD", "UFF"/)
669 :
670 : REAL(KIND=dp), DIMENSION(0:3) :: u
671 : REAL(KIND=dp), DIMENSION(2) :: dpddg, ppddg
672 2240 : REAL(KIND=dp), DIMENSION(:), POINTER :: beta, sexp
673 : TYPE(cp_logger_type), POINTER :: logger
674 :
675 2240 : NULLIFY (logger)
676 4480 : logger => cp_get_default_logger()
677 2240 : IF (ASSOCIATED(sep) .AND. BTEST(cp_print_key_should_output(logger%iter_info, subsys_section, &
678 : "PRINT%KINDS/SE_PARAMETERS"), cp_p_file)) THEN
679 :
680 : output_unit = cp_print_key_unit_nr(logger, subsys_section, "PRINT%KINDS/SE_PARAMETERS", &
681 78 : extension=".Log")
682 :
683 78 : IF (output_unit > 0) THEN
684 : CALL get_se_param(sep, name=name, typ=typ, defined=defined, &
685 : z=z, zeff=zeff, natorb=natorb, eheat=eheat, beta=beta, &
686 : sto_exponents=sexp, uss=uss, upp=upp, udd=udd, uff=uff, &
687 : alp=alp, eisol=eisol, gss=gss, gsp=gsp, gpp=gpp, gp2=gp2, &
688 : de=de, ass=ass, asp=asp, app=app, hsp=hsp, ppddg=ppddg, &
689 39 : acoul=acoul, nr=nr, dpddg=dpddg, ngauss=ngauss)
690 :
691 39 : u(0) = uss
692 39 : u(1) = upp
693 39 : u(2) = udd
694 39 : u(3) = uff
695 :
696 0 : SELECT CASE (typ)
697 : CASE DEFAULT
698 0 : CPABORT("Semiempirical method unknown")
699 : CASE (do_method_am1)
700 : WRITE (UNIT=output_unit, FMT="(/,A,T35,A,T67,A14)") &
701 0 : " Semi empirical parameters: ", "Austin Model 1 (AM1)", TRIM(name)
702 : CASE (do_method_rm1)
703 : WRITE (UNIT=output_unit, FMT="(/,A,T35,A,T67,A14)") &
704 0 : " Semi empirical parameters: ", "Recife Model 1 (RM1)", TRIM(name)
705 : CASE (do_method_pm3)
706 : WRITE (UNIT=output_unit, FMT="(/,A,T35,A,T67,A14)") &
707 0 : " Semi empirical parameters: ", "Parametric Method 3 (PM3) ", TRIM(name)
708 : CASE (do_method_pnnl)
709 : WRITE (UNIT=output_unit, FMT="(/,A,T35,A,T67,A14)") &
710 0 : " Semi empirical parameters: ", "PNNL method ", TRIM(name)
711 : CASE (do_method_pm6)
712 : WRITE (UNIT=output_unit, FMT="(/,A,T35,A,T67,A14)") &
713 27 : " Semi empirical parameters: ", "Parametric Method 6 (PM6) ", TRIM(name)
714 : CASE (do_method_pm6fm)
715 : WRITE (UNIT=output_unit, FMT="(/,A,T35,A,T67,A14)") &
716 0 : " Semi empirical parameters: ", "Parametric Method 6 (PM6-FM) ", TRIM(name)
717 : CASE (do_method_pdg)
718 : WRITE (UNIT=output_unit, FMT="(/,A,T35,A,T67,A14)") &
719 0 : " Semi empirical parameters: ", "PDDG/PM3 ", TRIM(name)
720 : CASE (do_method_mndo)
721 : WRITE (UNIT=output_unit, FMT="(/,A,T35,A,T67,A14)") &
722 0 : " Semi empirical parameters: ", "MNDO ", TRIM(name)
723 : CASE (do_method_mndod)
724 : WRITE (UNIT=output_unit, FMT="(/,A,T35,A,T67,A14)") &
725 39 : " Semi empirical parameters: ", "MNDOD", TRIM(name)
726 : END SELECT
727 :
728 : ! If defined print all its semi-empirical parameters
729 39 : IF (defined) THEN
730 : WRITE (UNIT=output_unit, FMT="(T16,A,T71,F10.2)") &
731 39 : "Effective core charge:", zeff
732 : WRITE (UNIT=output_unit, FMT="(T16,A,T71,I10)") &
733 39 : "Number of orbitals:", natorb, &
734 78 : "Basis set expansion (STO-NG)", ngauss
735 : WRITE (UNIT=output_unit, FMT="(T16,A,T66,F15.5)") &
736 39 : "Atomic heat of formation [kcal/mol]:", eheat*kcalmol
737 195 : DO l = 0, 3
738 195 : IF (ABS(beta(l)) > 0._dp) THEN
739 83 : WRITE (UNIT=output_unit, FMT="(T16,A,I2)") "Parameters for Shell: ", l
740 : WRITE (UNIT=output_unit, FMT="(T22,A5,T30,A,T64,F17.4)") &
741 83 : ADJUSTR(z_lab(l)), "- "//"Slater Exponent for "//orb_lab(l)//" [A]: ", sexp(l)
742 : WRITE (UNIT=output_unit, FMT="(T22,A5,T30,A,T64,F17.4)") &
743 83 : ADJUSTR(u_lab(l)), "- "//"One Center Energy for "//orb_lab(l)//" [eV]: ", u(l)*evolt
744 : WRITE (UNIT=output_unit, FMT="(T22,A5,T30,A,T64,F17.4)") &
745 83 : ADJUSTR(beta_lab(l)), "- "//"Beta Parameter for "//orb_lab(l)//" [eV]: ", beta(l)*evolt
746 : WRITE (UNIT=output_unit, FMT="(T22,A5,T30,A,T64,F17.4)") &
747 83 : ADJUSTR(zeta_lab(l)), "- "//"Internal Exponent for "//orb_lab(l)//" [a.u.]: ", sep%zn(l)
748 : END IF
749 : END DO
750 39 : WRITE (UNIT=output_unit, FMT="(/,T16,A)") "Additional Parameters (Derived or Fitted):"
751 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
752 39 : ADJUSTR("ALP"), "- "//"Alpha Parameter for Core [A^-1]: ", alp/angstrom
753 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
754 39 : ADJUSTR("EISOL"), "- "//"Atomic Energy (Calculated) [eV]: ", eisol*evolt
755 : ! One center Two electron Integrals
756 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
757 39 : ADJUSTR("GSS"), "- "//"One Center Integral (SS ,SS ) [eV]: ", gss*evolt
758 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
759 39 : ADJUSTR("GSP"), "- "//"One Center Integral (SS ,PP ) [eV]: ", gsp*evolt
760 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
761 39 : ADJUSTR("GPP"), "- "//"One Center Integral (PP ,PP ) [eV]: ", gpp*evolt
762 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
763 39 : ADJUSTR("GP2"), "- "//"One Center Integral (PP*,PP*) [eV]: ", gp2*evolt
764 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
765 39 : ADJUSTR("HSP"), "- "//"One Center Integral (SP ,SP ) [eV]: ", hsp*evolt
766 : ! Slater Condon Parameters
767 39 : IF (sep%dorb) THEN
768 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
769 17 : ADJUSTR("F0DD"), "- "//"Slater Condon Parameter F0DD [eV]: ", sep%f0dd
770 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
771 17 : ADJUSTR("F2DD"), "- "//"Slater Condon Parameter F2DD [eV]: ", sep%f2dd
772 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
773 17 : ADJUSTR("F4DD"), "- "//"Slater Condon Parameter F4DD [eV]: ", sep%f4dd
774 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
775 17 : ADJUSTR("FOSD"), "- "//"Slater Condon Parameter FOSD [eV]: ", sep%f0sd
776 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
777 17 : ADJUSTR("G2SD"), "- "//"Slater Condon Parameter G2SD [eV]: ", sep%g2sd
778 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
779 17 : ADJUSTR("F0PD"), "- "//"Slater Condon Parameter F0PD [eV]: ", sep%f0pd
780 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
781 17 : ADJUSTR("F2PD"), "- "//"Slater Condon Parameter F2PD [eV]: ", sep%f2pd
782 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
783 17 : ADJUSTR("G1PD"), "- "//"Slater Condon Parameter G1PD [eV]: ", sep%g1pd
784 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
785 17 : ADJUSTR("G3PD"), "- "//"Slater Condon Parameter G3PD [eV]: ", sep%g3pd
786 : END IF
787 : ! Charge Separation
788 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
789 39 : ADJUSTR("DD2"), "- "//"Charge Separation SP, L=1 [bohr]: ", sep%cs(2)
790 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
791 39 : ADJUSTR("DD3"), "- "//"Charge Separation PP, L=2 [bohr]: ", sep%cs(3)
792 39 : IF (sep%dorb) THEN
793 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
794 17 : ADJUSTR("DD4"), "- "//"Charge Separation SD, L=2 [bohr]: ", sep%cs(4)
795 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
796 17 : ADJUSTR("DD5"), "- "//"Charge Separation PD, L=1 [bohr]: ", sep%cs(5)
797 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
798 17 : ADJUSTR("DD6"), "- "//"Charge Separation DD, L=2 [bohr]: ", sep%cs(6)
799 : END IF
800 : ! Klopman-Ohno Terms
801 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
802 39 : ADJUSTR("PO1"), "- "//"Klopman-Ohno term, SS, L=0 [bohr]: ", sep%ko(1)
803 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
804 39 : ADJUSTR("PO2"), "- "//"Klopman-Ohno term, SP, L=1 [bohr]: ", sep%ko(2)
805 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
806 39 : ADJUSTR("PO3"), "- "//"Klopman-Ohno term, PP, L=2 [bohr]: ", sep%ko(3)
807 39 : IF (sep%dorb) THEN
808 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
809 17 : ADJUSTR("PO4"), "- "//"Klopman-Ohno term, SD, L=2 [bohr]: ", sep%ko(4)
810 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
811 17 : ADJUSTR("PO5"), "- "//"Klopman-Ohno term, PD, L=1 [bohr]: ", sep%ko(5)
812 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
813 17 : ADJUSTR("PO6"), "- "//"Klopman-Ohno term, DD, L=2 [bohr]: ", sep%ko(6)
814 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
815 17 : ADJUSTR("PO7"), "- "//"Klopman-Ohno term, PP, L=0 [bohr]: ", sep%ko(7)
816 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
817 17 : ADJUSTR("PO8"), "- "//"Klopman-Ohno term, DD, L=0 [bohr]: ", sep%ko(8)
818 : END IF
819 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
820 39 : ADJUSTR("PO9"), "- "//"Klopman-Ohno term, CORE [bohr]: ", sep%ko(9)
821 0 : SELECT CASE (typ)
822 : CASE (do_method_am1, do_method_rm1, do_method_pm3, do_method_pdg, do_method_pnnl)
823 39 : IF (typ == do_method_pnnl) THEN
824 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
825 0 : ADJUSTR("ASS"), "- "//" SS polarization [au]: ", sep%ass
826 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
827 0 : ADJUSTR("ASP"), "- "//" SP polarization [au]: ", sep%asp
828 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
829 0 : ADJUSTR("APP"), "- "//" PP polarization[au]: ", sep%app
830 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
831 0 : ADJUSTR("DE"), "- "//" Dispersion Parameter [eV]: ", sep%de*evolt
832 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
833 0 : ADJUSTR("ACOUL"), "- "//" Slater parameter: ", sep%acoul
834 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,I12)") &
835 0 : ADJUSTR("NR"), "- "//" Slater parameter: ", sep%nr
836 0 : ELSEIF ((typ == do_method_am1 .OR. typ == do_method_rm1) .AND. sep%z == 5) THEN
837 : ! Standard case
838 0 : DO i = 1, SIZE(sep%bfn1, 1)
839 0 : i_string = cp_to_string(i)
840 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
841 0 : ADJUSTR("FN1"//TRIM(ADJUSTL(i_string))//"_ALL"), &
842 0 : "- "//"Core-Core VDW, Multiplier [a.u.]: ", sep%bfn1(i, 1)
843 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
844 0 : ADJUSTR("FN2"//TRIM(ADJUSTL(i_string))//"_ALL"), &
845 0 : "- "//"Core-Core VDW, Exponent [a.u.]: ", sep%bfn2(i, 1)
846 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
847 0 : ADJUSTR("FN3"//TRIM(ADJUSTL(i_string))//"_ALL"), &
848 0 : "- "//"Core-Core VDW, Position [a.u.]: ", sep%bfn3(i, 1)
849 : END DO
850 : ! Special Case : Hydrogen
851 0 : DO i = 1, SIZE(sep%bfn1, 1)
852 0 : i_string = cp_to_string(i)
853 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
854 0 : ADJUSTR("FN1"//TRIM(ADJUSTL(i_string))//"_H"), &
855 0 : "- "//"Core-Core VDW, Multiplier [a.u.]: ", sep%bfn1(i, 2)
856 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
857 0 : ADJUSTR("FN2"//TRIM(ADJUSTL(i_string))//"_H"), &
858 0 : "- "//"Core-Core VDW, Exponent [a.u.]: ", sep%bfn2(i, 2)
859 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
860 0 : ADJUSTR("FN3"//TRIM(ADJUSTL(i_string))//"_H"), &
861 0 : "- "//"Core-Core VDW, Position [a.u.]: ", sep%bfn3(i, 2)
862 : END DO
863 : ! Special Case : Carbon
864 0 : DO i = 1, SIZE(sep%bfn1, 1)
865 0 : i_string = cp_to_string(i)
866 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
867 0 : ADJUSTR("FN1"//TRIM(ADJUSTL(i_string))//"_C"), &
868 0 : "- "//"Core-Core VDW, Multiplier [a.u.]: ", sep%bfn1(i, 3)
869 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
870 0 : ADJUSTR("FN2"//TRIM(ADJUSTL(i_string))//"_C"), &
871 0 : "- "//"Core-Core VDW, Exponent [a.u.]: ", sep%bfn2(i, 3)
872 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
873 0 : ADJUSTR("FN3"//TRIM(ADJUSTL(i_string))//"_C"), &
874 0 : "- "//"Core-Core VDW, Position [a.u.]: ", sep%bfn3(i, 3)
875 : END DO
876 : ! Special Case : Halogens
877 0 : DO i = 1, SIZE(sep%bfn1, 1)
878 0 : i_string = cp_to_string(i)
879 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
880 0 : ADJUSTR("FN1"//TRIM(ADJUSTL(i_string))//"_HALO"), &
881 0 : "- "//"Core-Core VDW, Multiplier [a.u.]: ", sep%bfn1(i, 4)
882 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
883 0 : ADJUSTR("FN2"//TRIM(ADJUSTL(i_string))//"_HALO"), &
884 0 : "- "//"Core-Core VDW, Exponent [a.u.]: ", sep%bfn2(i, 4)
885 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
886 0 : ADJUSTR("FN3"//TRIM(ADJUSTL(i_string))//"_HALO"), &
887 0 : "- "//"Core-Core VDW, Position [a.u.]: ", sep%bfn3(i, 4)
888 : END DO
889 : ELSE
890 0 : DO i = 1, SIZE(sep%fn1, 1)
891 0 : i_string = cp_to_string(i)
892 : ! Skip the printing of params that are zero..
893 0 : IF (sep%fn1(i) == 0.0_dp .AND. sep%fn2(i) == 0.0_dp .AND. sep%fn3(i) == 0.0_dp) CYCLE
894 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
895 0 : ADJUSTR("FN1"//TRIM(ADJUSTL(i_string))), &
896 0 : "- "//"Core-Core VDW, Multiplier [a.u.]: ", sep%fn1(i)
897 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
898 0 : ADJUSTR("FN2"//TRIM(ADJUSTL(i_string))), &
899 0 : "- "//"Core-Core VDW, Exponent [a.u.]: ", sep%fn2(i)
900 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T69,F12.4)") &
901 0 : ADJUSTR("FN3"//TRIM(ADJUSTL(i_string))), &
902 0 : "- "//"Core-Core VDW, Position [a.u.]: ", sep%fn3(i)
903 : END DO
904 : END IF
905 : END SELECT
906 : ELSE
907 0 : WRITE (UNIT=output_unit, FMT="(T55,A)") "Parameters are not defined"
908 : END IF
909 :
910 : ! Additional Parameters not common to all semi-empirical methods
911 0 : SELECT CASE (typ)
912 : CASE (do_method_pdg)
913 : WRITE (UNIT=output_unit, FMT="(T16,A11,T30,A,T52,F14.10,T67,F14.10)") &
914 0 : ADJUSTR("d_PDDG"), "- "//"Exponent [A^-1]:", dpddg/angstrom, &
915 39 : ADJUSTR("P_PDDG"), "- "//"Parameter [eV]:", ppddg*evolt
916 : END SELECT
917 : END IF
918 : CALL cp_print_key_finished_output(output_unit, logger, subsys_section, &
919 78 : "PRINT%KINDS/SE_PARAMETERS")
920 : END IF
921 2240 : END SUBROUTINE write_se_param
922 :
923 0 : END MODULE semi_empirical_types
|
