74 a_bohr,
angstrom,
bohr,
boltzmann,
c_light,
debye,
e_mass,
h_bar,
hertz,
joule,
kelvin, &
82#include "../base/base_uses.f90"
86 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'vibrational_analysis'
87 LOGICAL,
PARAMETER :: debug_this_module = .false.
101 SUBROUTINE vb_anal(input, input_declaration, para_env, globenv)
107 CHARACTER(len=*),
PARAMETER :: routinen =
'vb_anal'
108 CHARACTER(LEN=1),
DIMENSION(3),
PARAMETER :: lab = [
"X",
"Y",
"Z"]
110 CHARACTER(LEN=default_string_length) :: description_d, description_p
111 INTEGER :: handle, i, icoord, icoordm, icoordp, ierr, imap, iounit, ip1, ip2, iparticle1, &
112 iparticle2, iseq, iw, j, k, natoms, ncoord, nfrozen, nrep, nres, nrottrm, nvib, &
113 output_unit, output_unit_eig, prep, print_grrm, print_namd, print_scine, proc_dist_type
114 INTEGER,
DIMENSION(:),
POINTER :: clist, mlist
115 LOGICAL :: calc_intens, calc_thchdata, do_mode_tracking, intens_ir, intens_raman, &
116 keep_rotations, row_force, something_frozen
117 REAL(kind=
dp) :: a1, a2, a3, conver, dummy, dx, &
118 inertia(3), minimum_energy, norm, &
119 tc_press, tc_temp, tmp
120 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:) :: h_eigval1, h_eigval2, heigvaldfull, &
121 konst, mass, pos0, rmass
122 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:, :) :: hessian, hessian_umw, hint1, hint2, &
124 REAL(kind=
dp),
DIMENSION(3) :: d_deriv, d_print
125 REAL(kind=
dp),
DIMENSION(3, 3) :: p_deriv, p_print
126 REAL(kind=
dp),
DIMENSION(:),
POINTER :: depol_p, depol_u, depp, depu, din, &
127 intensities_d, intensities_p, pin
128 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: d, dfull, dip_deriv, rottrm
129 REAL(kind=
dp),
DIMENSION(:, :, :),
POINTER :: polar_deriv, tmp_dip
130 REAL(kind=
dp),
DIMENSION(:, :, :, :),
POINTER :: tmp_polar
137 mode_tracking_section, print_section, &
140 CALL timeset(routinen, handle)
141 NULLIFY (d, rottrm, logger, subsys, f_env, particles, rep_env, intensities_d, intensities_p, &
142 vib_section, print_section, depol_p, depol_u)
148 "PROGRAM_RUN_INFO", &
157 file_status=
"REPLACE", &
158 file_action=
"WRITE", &
160 file_form=
"UNFORMATTED")
173 tc_press = tc_press*
pascal
176 intens_raman = .false.
180 nrep = max(1, para_env%num_pe/prep)
181 prep = para_env%num_pe/nrep
189 input_declaration=input_declaration, nrep=nrep, prep=prep, row_force=row_force)
190 IF (
ASSOCIATED(rep_env))
THEN
193 particles => subsys%particles%els
195 IF (do_mode_tracking)
THEN
196 CALL ms_vb_anal(input, rep_env, para_env, globenv, particles, &
197 nrep, calc_intens, dx, output_unit, logger)
200 CALL get_moving_atoms(force_env=f_env%force_env, ilist=mlist)
201 something_frozen =
SIZE(particles) /=
SIZE(mlist)
204 ALLOCATE (clist(ncoord))
205 ALLOCATE (mass(natoms))
206 ALLOCATE (pos0(ncoord))
207 ALLOCATE (hessian(ncoord, ncoord))
208 ALLOCATE (hessian_umw(ncoord, ncoord))
209 IF (calc_intens)
THEN
210 description_d =
'[DIPOLE]'
211 ALLOCATE (tmp_dip(ncoord, 3, 2))
213 description_p =
'[POLAR]'
214 ALLOCATE (tmp_polar(ncoord, 3, 3, 2))
220 clist((i - 1)*3 + 1) = (imap - 1)*3 + 1
221 clist((i - 1)*3 + 2) = (imap - 1)*3 + 2
222 clist((i - 1)*3 + 3) = (imap - 1)*3 + 3
223 mass(i) = particles(imap)%atomic_kind%mass
224 cpassert(mass(i) > 0.0_dp)
225 mass(i) = sqrt(mass(i))
226 pos0((i - 1)*3 + 1) = particles(imap)%r(1)
227 pos0((i - 1)*3 + 2) = particles(imap)%r(2)
228 pos0((i - 1)*3 + 3) = particles(imap)%r(3)
234 IF (something_frozen)
THEN
236 ALLOCATE (rottrm(natoms*3, nrottrm))
238 CALL rot_ana(particles, rottrm, nrottrm, print_section, &
239 keep_rotations, mass_weighted=.true., natoms=natoms, inertia=inertia)
242 nvib = 3*natoms - nrottrm
245 ALLOCATE (d(3*natoms, 3*natoms))
247 ALLOCATE (d(3*natoms, nvib))
249 CALL build_d_matrix(rottrm, nrottrm, d, full=.false., &
254 hessian = huge(0.0_dp)
255 hessian_umw = huge(0.0_dp)
256 IF (output_unit > 0)
WRITE (output_unit,
'(/,T2,A)')
"VIB| Vibrational Analysis Info"
257 DO icoordp = 1, ncoord, nrep
262 rep_env%r(imap, j) = pos0(i)
264 IF (icoord + j <= ncoord)
THEN
265 imap = clist(icoord + j)
266 rep_env%r(imap, j) = rep_env%r(imap, j) + dx
272 IF (calc_intens)
THEN
273 IF (icoord + j <= ncoord)
THEN
275 description=description_d))
THEN
276 CALL get_results(results=rep_env%results(j)%results, &
277 description=description_d, &
279 CALL get_results(results=rep_env%results(j)%results, &
280 description=description_d, &
281 values=tmp_dip(icoord + j, :, 1), &
284 d_print(:) = tmp_dip(icoord + j, :, 1)
287 description=description_p))
THEN
288 CALL get_results(results=rep_env%results(j)%results, &
289 description=description_p, &
291 CALL get_results(results=rep_env%results(j)%results, &
292 description=description_p, &
293 values=tmp_polar(icoord + j, :, :, 1), &
295 intens_raman = .true.
296 p_print(:, :) = tmp_polar(icoord + j, :, :, 1)
300 IF (icoord + j <= ncoord)
THEN
303 hessian(i, icoord + j) = rep_env%f(imap, j)
305 imap = clist(icoord + j)
307 IF (output_unit > 0)
THEN
309 IF (mod(imap, 3) /= 0) iparticle1 = iparticle1 + 1
310 WRITE (output_unit,
'(T2,A,I5,A,I5,3A)') &
311 "VIB| REPLICA Nr.", j,
"- Energy and Forces for particle:", &
312 iparticle1,
" coordinate: ", lab(imap - (iparticle1 - 1)*3), &
313 " + D"//trim(lab(imap - (iparticle1 - 1)*3))
314 WRITE (output_unit,
'(T2,A,T43,A,T57,F24.12)') &
315 "VIB|",
"Total energy:", rep_env%f(rep_env%ndim + 1, j)
316 WRITE (output_unit,
'(T2,"VIB|",T10,"ATOM",T33,3(9X,A,7X))') lab(1), lab(2), lab(3)
319 WRITE (output_unit,
'(T2,"VIB|",T12,A,T30,3(2X,F15.9))') &
320 particles(imap)%atomic_kind%name, &
321 rep_env%f((imap - 1)*3 + 1:(imap - 1)*3 + 3, j)
324 WRITE (output_unit,
'(T3,A)')
'Dipole moment [Debye]'
325 WRITE (output_unit,
'(T5,3(A,F14.8,1X),T60,A,T67,F14.8)') &
326 'X=', d_print(1)*
debye,
'Y=', d_print(2)*
debye,
'Z=', d_print(3)*
debye, &
327 'Total=', sqrt(sum(d_print(1:3)**2))*
debye
329 IF (intens_raman)
THEN
330 WRITE (output_unit,
'(T2,A)') &
331 'POLAR| Polarizability tensor [a.u.]'
332 WRITE (output_unit,
'(T2,A,T24,3(1X,F18.12))') &
333 'POLAR| xx,yy,zz', p_print(1, 1), p_print(2, 2), p_print(3, 3)
334 WRITE (output_unit,
'(T2,A,T24,3(1X,F18.12))') &
335 'POLAR| xy,xz,yz', p_print(1, 2), p_print(1, 3), p_print(2, 3)
336 WRITE (output_unit,
'(T2,A,T24,3(1X,F18.12),/)') &
337 'POLAR| yx,zx,zy', p_print(2, 1), p_print(3, 1), p_print(3, 2)
343 DO icoordm = 1, ncoord, nrep
348 rep_env%r(imap, j) = pos0(i)
350 IF (icoord + j <= ncoord)
THEN
351 imap = clist(icoord + j)
352 rep_env%r(imap, j) = rep_env%r(imap, j) - dx
358 IF (calc_intens)
THEN
359 IF (icoord + j <= ncoord)
THEN
360 k = (icoord + j + 2)/3
362 description=description_d))
THEN
363 CALL get_results(results=rep_env%results(j)%results, &
364 description=description_d, &
366 CALL get_results(results=rep_env%results(j)%results, &
367 description=description_d, &
368 values=tmp_dip(icoord + j, :, 2), &
370 tmp_dip(icoord + j, :, 1) = (tmp_dip(icoord + j, :, 1) - &
371 tmp_dip(icoord + j, :, 2))/(2.0_dp*dx*mass(k))
372 d_print(:) = tmp_dip(icoord + j, :, 1)
375 description=description_p))
THEN
376 CALL get_results(results=rep_env%results(j)%results, &
377 description=description_p, &
379 CALL get_results(results=rep_env%results(j)%results, &
380 description=description_p, &
381 values=tmp_polar(icoord + j, :, :, 2), &
383 tmp_polar(icoord + j, :, :, 1) = (tmp_polar(icoord + j, :, :, 1) - &
384 tmp_polar(icoord + j, :, :, 2))/(2.0_dp*dx*mass(k))
385 p_print(:, :) = tmp_polar(icoord + j, :, :, 1)
389 IF (icoord + j <= ncoord)
THEN
390 imap = clist(icoord + j)
392 IF (mod(imap, 3) /= 0) iparticle1 = iparticle1 + 1
394 IF (mod(icoord + j, 3) /= 0) ip1 = ip1 + 1
396 IF (output_unit > 0)
THEN
397 WRITE (output_unit,
'(T2,A,I5,A,I5,3A)') &
398 "VIB| REPLICA Nr.", j,
"- Energy and Forces for particle:", &
399 iparticle1,
" coordinate: ", lab(imap - (iparticle1 - 1)*3), &
400 " - D"//trim(lab(imap - (iparticle1 - 1)*3))
401 WRITE (output_unit,
'(T2,A,T43,A,T57,F24.12)') &
402 "VIB|",
"Total energy:", rep_env%f(rep_env%ndim + 1, j)
403 WRITE (output_unit,
'(T2,"VIB|",T10,"ATOM",T33,3(9X,A,7X))') lab(1), lab(2), lab(3)
406 WRITE (output_unit,
'(T2,"VIB|",T12,A,T30,3(2X,F15.9))') &
407 particles(imap)%atomic_kind%name, &
408 rep_env%f((imap - 1)*3 + 1:(imap - 1)*3 + 3, j)
411 WRITE (output_unit,
'(T3,A)')
'Dipole moment [Debye]'
412 WRITE (output_unit,
'(T5,3(A,F14.8,1X),T60,A,T67,F14.8)') &
413 'X=', d_print(1)*
debye,
'Y=', d_print(2)*
debye,
'Z=', d_print(3)*
debye, &
414 'Total=', sqrt(sum(d_print(1:3)**2))*
debye
416 IF (intens_raman)
THEN
417 WRITE (output_unit,
'(T2,A)') &
418 'POLAR| Polarizability tensor [a.u.]'
419 WRITE (output_unit,
'(T2,A,T24,3(1X,F18.12))') &
420 'POLAR| xx,yy,zz', p_print(1, 1), p_print(2, 2), p_print(3, 3)
421 WRITE (output_unit,
'(T2,A,T24,3(1X,F18.12))') &
422 'POLAR| xy,xz,yz', p_print(1, 2), p_print(1, 3), p_print(2, 3)
423 WRITE (output_unit,
'(T2,A,T24,3(1X,F18.12),/)') &
424 'POLAR| yx,zx,zy', p_print(2, 1), p_print(3, 1), p_print(3, 2)
430 IF (mod(imap, 3) /= 0) iparticle2 = iparticle2 + 1
432 IF (mod(iseq, 3) /= 0) ip2 = ip2 + 1
433 tmp = hessian(iseq, icoord + j) - rep_env%f(imap, j)
436 hessian_umw(iseq, icoord + j) = -tmp/(2.0_dp*dx)
437 hessian(iseq, icoord + j) = hessian_umw(iseq, icoord + j)*1e6_dp/(mass(ip1)*mass(ip2))
446 particles(imap)%r(1:3) = pos0((i - 1)*3 + 1:(i - 1)*3 + 3)
451 rep_env%r(imap, j) = pos0(i)
456 minimum_energy = rep_env%f(rep_env%ndim + 1, j)
457 IF (output_unit > 0)
THEN
458 WRITE (output_unit,
'(T2,A)') &
459 "VIB| ",
" Minimum Structure - Energy and Forces:"
460 WRITE (output_unit,
'(T2,A,T43,A,T57,F24.12)') &
461 "VIB|",
"Total energy:", rep_env%f(rep_env%ndim + 1, j)
462 WRITE (output_unit,
'(T2,"VIB|",T10,"ATOM",T33,3(9X,A,7X))') lab(1), lab(2), lab(3)
465 WRITE (output_unit,
'(T2,"VIB|",T12,A,T30,3(2X,F15.9))') &
466 particles(imap)%atomic_kind%name, &
467 rep_env%f((imap - 1)*3 + 1:(imap - 1)*3 + 3, j)
472 IF (output_unit > 0)
THEN
473 WRITE (output_unit,
'(/,T2,A)') &
474 "VIB| Hessian (before multiplying by 1E6/(sqrt(mass_i)*sqrt(mass_j)))"
477 WRITE (output_unit,
'(/,T2,A)') &
478 "VIB| Hessian in cartesian coordinates (mass weighted)"
483 CALL write_va_hessian(vib_section, para_env, ncoord, globenv, hessian, logger)
489 hessian(j, i) = hessian(i, j)
495 file_position=
"REWIND", extension=
".rrm")
496 IF (print_grrm > 0)
THEN
499 particles(imap)%f(1:3) = rep_env%f((imap - 1)*3 + 1:(imap - 1)*3 + 3, 1)
501 ALLOCATE (hint1(ncoord, ncoord), rmass(ncoord))
504 rmass(3*(imap - 1) + 1:3*(imap - 1) + 3) = mass(imap)
508 hint1(j, i) = hessian(j, i)*rmass(i)*rmass(j)*1.0e-6_dp
511 nfrozen =
SIZE(particles) - natoms
512 CALL write_grrm(print_grrm, f_env%force_env, particles, minimum_energy, &
513 hessian=hint1, fixed_atoms=nfrozen)
514 DEALLOCATE (hint1, rmass)
520 file_position=
"REWIND", extension=
".scine")
521 IF (print_scine > 0)
THEN
524 particles(imap)%f(1:3) = rep_env%f((imap - 1)*3 + 1:(imap - 1)*3 + 3, 1)
526 nfrozen =
SIZE(particles) - natoms
527 cpassert(nfrozen == 0)
528 CALL write_scine(print_scine, f_env%force_env, particles, minimum_energy, hessian=hessian)
534 extension=
".eig", file_status=
"REPLACE", &
535 file_action=
"WRITE", do_backup=.true., &
536 file_form=
"UNFORMATTED")
537 IF (print_namd > 0)
THEN
541 ALLOCATE (dfull(ncoord, ncoord))
542 ALLOCATE (hint2dfull(
SIZE(dfull, 2),
SIZE(dfull, 2)))
543 ALLOCATE (heigvaldfull(
SIZE(dfull, 2)))
544 ALLOCATE (matm(ncoord, ncoord))
545 ALLOCATE (rmass(
SIZE(dfull, 2)))
548 CALL build_d_matrix(rottrm, nrottrm, dfull, full=.true., natoms=natoms)
551 hint2dfull(:, :) = matmul(transpose(dfull), matmul(hessian, dfull))
559 matm((i - 1)*3 + j, (i - 1)*3 + j) = 1.0_dp/mass(i)
563 dfull = matmul(matm, matmul(dfull, hint2dfull))
566 norm = 1.0_dp/sum(dfull(:, i)*dfull(:, i))
568 dfull(:, i) = sqrt(norm)*(dfull(:, i))
570 CALL write_eigs_unformatted(print_namd, ncoord, heigvaldfull, dfull)
571 DEALLOCATE (heigvaldfull)
572 DEALLOCATE (hint2dfull)
578 nvib = ncoord - nrottrm
579 ALLOCATE (h_eigval1(ncoord))
580 ALLOCATE (h_eigval2(
SIZE(d, 2)))
581 ALLOCATE (hint1(ncoord, ncoord))
582 ALLOCATE (hint2(
SIZE(d, 2),
SIZE(d, 2)))
583 ALLOCATE (rmass(
SIZE(d, 2)))
584 ALLOCATE (konst(
SIZE(d, 2)))
585 IF (calc_intens)
THEN
586 ALLOCATE (dip_deriv(3,
SIZE(d, 2)))
588 ALLOCATE (polar_deriv(3, 3,
SIZE(d, 2)))
591 ALLOCATE (intensities_d(
SIZE(d, 2)))
592 ALLOCATE (intensities_p(
SIZE(d, 2)))
593 ALLOCATE (depol_p(
SIZE(d, 2)))
594 ALLOCATE (depol_u(
SIZE(d, 2)))
595 intensities_d = 0._dp
596 intensities_p = 0._dp
599 hint1(:, :) = hessian
601 IF (output_unit > 0)
THEN
602 WRITE (output_unit,
'(/,T2,A)')
"VIB| Cartesian Low frequencies ---"
604 WRITE (output_unit,
'(T2,A,T6,5(1X,ES14.7E2))') &
605 "VIB|", h_eigval1(i:min(i + 4, ncoord))
607 WRITE (output_unit,
'(/,T2,A)')
"VIB| Eigenvectors before removal of rotations and translations"
612 IF (output_unit_eig > 0)
THEN
613 CALL write_eigs_unformatted(output_unit_eig, ncoord, h_eigval1, hint1)
616 hint2(:, :) = matmul(transpose(d), matmul(hessian, d))
617 IF (calc_intens)
THEN
619 dip_deriv(i, :) = matmul(tmp_dip(:, i, 1), d)
623 polar_deriv(i, j, :) = matmul(tmp_polar(:, i, j, 1), d)
628 IF (output_unit > 0)
THEN
629 WRITE (output_unit,
'(/,T2,"VIB| Frequencies after removal of the rotations and translations")')
631 WRITE (output_unit,
'(/,T2,A)')
"VIB| Internal Low frequencies ---"
632 DO i = 1, ncoord - 6, 5
633 WRITE (output_unit,
'(T2,A,T6,5(1X,ES14.7E2))') &
634 "VIB|", h_eigval2(i:min(i + 4, ncoord - 6))
640 hessian((i - 1)*3 + j, (i - 1)*3 + j) = 1.0_dp/mass(i)
644 d = matmul(hessian, matmul(d, hint2))
646 norm = 1.0_dp/sum(d(:, i)*d(:, i))
650 d(:, i) = sqrt(norm)*d(:, i)
651 IF (calc_intens)
THEN
654 d_deriv(:) = d_deriv(:) + dip_deriv(:, j)*hint2(j, i)
656 intensities_d(i) = sqrt(dot_product(d_deriv, d_deriv))
660 p_deriv(:, :) = p_deriv(:, :) + polar_deriv(:, :, j)*hint2(j, i)
664 p_deriv(:, :) = p_deriv(:, :)*conver
666 a1 = (p_deriv(1, 1) + p_deriv(2, 2) + p_deriv(3, 3))/3.0_dp
667 a2 = (p_deriv(1, 1) - p_deriv(2, 2))**2 + &
668 (p_deriv(2, 2) - p_deriv(3, 3))**2 + &
669 (p_deriv(3, 3) - p_deriv(1, 1))**2
670 a3 = (p_deriv(1, 2)**2 + p_deriv(2, 3)**2 + p_deriv(3, 1)**2)
671 intensities_p(i) = 45.0_dp*a1*a1 + 7.0_dp/2.0_dp*(a2 + 6.0_dp*a3)
673 dummy = 45.0_dp*a1*a1 + 4.0_dp/2.0_dp*(a2 + 6.0_dp*a3)
674 IF (dummy > 5.e-7_dp)
THEN
676 depol_p(i) = 3.0_dp/2.0_dp*(a2 + 6.0_dp*a3)/(45.0_dp*a1*a1 + &
677 4.0_dp/2.0_dp*(a2 + 6.0_dp*a3))
679 depol_u(i) = 6.0_dp/2.0_dp*(a2 + 6.0_dp*a3)/(45.0_dp*a1*a1 + &
680 7.0_dp/2.0_dp*(a2 + 6.0_dp*a3))
687 h_eigval2(i) = sign(1.0_dp, h_eigval2(i))*sqrt(abs(h_eigval2(i))*
massunit)*
vibfac/1000.0_dp
691 IF (calc_intens)
THEN
693 IF (.NOT. intens_ir)
THEN
694 WRITE (iounit,
'(T2,"VIB| No IR intensities available. Check input")')
696 IF (.NOT. intens_raman)
THEN
697 WRITE (iounit,
'(T2,"VIB| No Raman intensities available. Check input")')
704 NULLIFY (din, pin, depp, depu)
705 IF (intens_ir) din => intensities_d
706 IF (intens_raman) pin => intensities_p
707 IF (intens_raman) depp => depol_p
708 IF (intens_raman) depu => depol_u
709 CALL vib_out(iw, nvib, d, konst, rmass, h_eigval2, particles, mlist, din, pin, depp, depu)
711 IF (.NOT. something_frozen .AND. calc_thchdata)
THEN
712 CALL get_thch_values(h_eigval2, iw, mass, nvib, inertia, 1, minimum_energy, tc_temp, tc_press)
715 dump_only_positive=.false., logger=logger,
list=mlist)
717 IF (output_unit > 0)
THEN
718 WRITE (output_unit,
'(T2,"VIB| No further vibrational info. Detected a single atom")')
725 DEALLOCATE (h_eigval1)
726 DEALLOCATE (h_eigval2)
735 DEALLOCATE (hessian_umw)
736 IF (calc_intens)
THEN
737 DEALLOCATE (dip_deriv)
738 DEALLOCATE (polar_deriv)
740 DEALLOCATE (tmp_polar)
742 DEALLOCATE (intensities_d)
743 DEALLOCATE (intensities_p)
752 CALL timestop(handle)
761 SUBROUTINE get_moving_atoms(force_env, Ilist)
763 INTEGER,
DIMENSION(:),
POINTER :: ilist
765 CHARACTER(len=*),
PARAMETER :: routinen =
'get_moving_atoms'
767 INTEGER :: handle, i, ii, ikind, j, ndim, &
768 nfixed_atoms, nfixed_atoms_total, nkind
769 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: ifixd_list, work
778 CALL timeset(routinen, handle)
782 molecule_kinds=molecule_kinds)
784 nkind = molecule_kinds%n_els
785 molecule_kind_set => molecule_kinds%els
786 particle_set => particles%els
789 nfixed_atoms_total = 0
791 molecule_kind => molecule_kind_set(ikind)
793 nfixed_atoms_total = nfixed_atoms_total + nfixed_atoms
795 ndim =
SIZE(particle_set) - nfixed_atoms_total
797 ALLOCATE (ilist(ndim))
799 IF (nfixed_atoms_total /= 0)
THEN
800 ALLOCATE (ifixd_list(nfixed_atoms_total))
801 ALLOCATE (work(nfixed_atoms_total))
802 nfixed_atoms_total = 0
804 molecule_kind => molecule_kind_set(ikind)
806 IF (
ASSOCIATED(fixd_list))
THEN
807 DO ii = 1,
SIZE(fixd_list)
808 IF (.NOT. fixd_list(ii)%restraint%active)
THEN
809 nfixed_atoms_total = nfixed_atoms_total + 1
810 ifixd_list(nfixed_atoms_total) = fixd_list(ii)%fixd
815 CALL sort(ifixd_list, nfixed_atoms_total, work)
819 loop_count:
DO i = 1,
SIZE(particle_set)
820 DO WHILE (i > ifixd_list(j))
822 IF (j > nfixed_atoms_total)
EXIT loop_count
824 IF (i /= ifixd_list(j))
THEN
829 DEALLOCATE (ifixd_list)
835 DO j = i,
SIZE(particle_set)
839 CALL timestop(handle)
841 END SUBROUTINE get_moving_atoms
859 SUBROUTINE vib_out(iw, nvib, D, k, m, freq, particles, Mlist, intensities_d, intensities_p, &
861 INTEGER,
INTENT(IN) :: iw, nvib
862 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: d
863 REAL(kind=
dp),
DIMENSION(:),
INTENT(IN) :: k, m, freq
865 INTEGER,
DIMENSION(:),
POINTER :: mlist
866 REAL(kind=
dp),
DIMENSION(:),
POINTER :: intensities_d, intensities_p, depol_p, &
869 CHARACTER(LEN=2) :: element_symbol
870 INTEGER :: from, iatom, icol, j, jatom, katom, &
872 REAL(kind=
dp) :: fint, pint
877 WRITE (unit=iw, fmt=
"(/,T2,'VIB|',T30,'NORMAL MODES - CARTESIAN DISPLACEMENTS')")
878 WRITE (unit=iw, fmt=
"(T2,'VIB|')")
879 DO jatom = 1, nvib, 3
881 to = min(from + 2, nvib)
882 WRITE (unit=iw, fmt=
"(T2,'VIB|',13X,3(8X,I5,8X))") &
883 (icol, icol=from, to)
884 WRITE (unit=iw, fmt=
"(T2,'VIB|Frequency (cm^-1)',3(1X,ES17.10E2,2X))") &
885 (freq(icol), icol=from, to)
886 IF (
ASSOCIATED(intensities_d))
THEN
887 WRITE (unit=iw, fmt=
"(T2,'VIB|IR int (KM/Mole) ',3(1X,ES17.10E2,2X))") &
888 (fint*intensities_d(icol)**2, icol=from, to)
890 IF (
ASSOCIATED(intensities_p))
THEN
891 WRITE (unit=iw, fmt=
"(T2,'VIB|Raman (A^4/amu) ',3(1X,ES17.10E2,2X))") &
892 (pint*intensities_p(icol), icol=from, to)
893 WRITE (unit=iw, fmt=
"(T2,'VIB|Depol Ratio (P) ',3(1X,ES17.10E2,2X))") &
894 (depol_p(icol), icol=from, to)
895 WRITE (unit=iw, fmt=
"(T2,'VIB|Depol Ratio (U) ',3(1X,ES17.10E2,2X))") &
896 (depol_u(icol), icol=from, to)
898 WRITE (unit=iw, fmt=
"(T2,'VIB|Red.Masses (a.u.)',3(1X,ES17.10E2,2X))") &
899 (m(icol), icol=from, to)
900 WRITE (unit=iw, fmt=
"(T2,'VIB|Frc consts (a.u.)',3(1X,ES17.10E2,2X))") &
901 (k(icol), icol=from, to)
902 WRITE (unit=iw, fmt=
"(T2,' ATOM',2X,'EL',10X,3(3X,' X ',1X,' Y ',1X,' Z '))")
903 DO iatom = 1, natom, 3
905 IF (mod(iatom, 3) /= 0) katom = katom + 1
906 CALL get_atomic_kind(atomic_kind=particles(mlist(katom))%atomic_kind, &
907 element_symbol=element_symbol)
908 WRITE (unit=iw, fmt=
"(T2,I5,2X,A2,10X,3(3X,2(F5.2,1X),F5.2))") &
909 mlist(katom), element_symbol, &
910 ((d(iatom + j, icol), j=0, 2), icol=from, to)
912 WRITE (unit=iw, fmt=
"(/)")
915 END SUBROUTINE vib_out
927 SUBROUTINE build_d_matrix(mat, dof, Dout, full, natoms)
928 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: mat
929 INTEGER,
INTENT(IN) :: dof
930 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: dout
931 LOGICAL,
OPTIONAL :: full
932 INTEGER,
INTENT(IN) :: natoms
934 CHARACTER(len=*),
PARAMETER :: routinen =
'build_D_matrix'
936 INTEGER :: handle, i, ifound, iseq, j, nvib
938 REAL(kind=
dp) :: norm
939 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:) :: work
940 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:, :) :: d
942 CALL timeset(routinen, handle)
944 IF (
PRESENT(full)) my_full = full
946 nvib = 3*natoms - dof
947 ALLOCATE (work(3*natoms))
948 ALLOCATE (d(3*natoms, 3*natoms))
953 norm = dot_product(mat(:, i), mat(:, j))
955 cpwarn(
"Orthogonality error in transformation matrix")
962 DO WHILE (ifound /= nvib)
964 cpassert(iseq <= 3*natoms)
968 DO i = 1, dof + ifound
969 norm = dot_product(work, d(:, i))
970 work(:) = work - norm*d(:, i)
973 norm = sqrt(dot_product(work, work))
977 d(:, dof + ifound) = work/norm
980 cpassert(dof + ifound == 3*natoms)
984 dout = d(:, dof + 1:)
988 CALL timestop(handle)
989 END SUBROUTINE build_d_matrix
1006 SUBROUTINE get_thch_values(freqs, iw, mass, nvib, inertia, spin, totene, temp, pressure)
1008 REAL(kind=
dp),
DIMENSION(:) :: freqs
1009 INTEGER,
INTENT(IN) :: iw
1010 REAL(kind=
dp),
DIMENSION(:) :: mass
1011 INTEGER,
INTENT(IN) :: nvib
1012 REAL(kind=
dp),
INTENT(IN) :: inertia(3)
1013 INTEGER,
INTENT(IN) :: spin
1014 REAL(kind=
dp),
INTENT(IN) :: totene, temp, pressure
1016 INTEGER :: i, natoms, sym_num
1017 REAL(kind=
dp) :: el_entropy, entropy, exp_min_one, fact, fact2, freq_arg, freq_arg2, &
1018 freqsum, gibbs, heat_capacity, inertia_kg(3), mass_tot, one_min_exp, partition_function, &
1019 rot_cv, rot_energy, rot_entropy, rot_part_func, rotvibtra, tran_cv, tran_energy, &
1020 tran_enthalpy, tran_entropy, tran_part_func, vib_cv, vib_energy, vib_entropy, &
1022 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:) :: mass_kg
1029 freqsum = freqsum + freqs(i)
1038 ALLOCATE (mass_kg(natoms))
1039 mass_kg(:) = mass(:)**2*
e_mass
1040 mass_tot = sum(mass_kg)
1046 IF (inertia_kg(1)*inertia_kg(2)*inertia_kg(3) > 1.0_dp)
THEN
1047 rot_part_func = fact*fact*fact*inertia_kg(1)*inertia_kg(2)*inertia_kg(3)*
pi
1048 rot_part_func = sqrt(rot_part_func)
1054 IF (inertia_kg(1) > 1.0_dp)
THEN
1055 rot_part_func = fact*inertia_kg(1)
1056 ELSE IF (inertia_kg(2) > 1.0_dp)
THEN
1057 rot_part_func = fact*inertia_kg(2)
1059 rot_part_func = fact*inertia_kg(3)
1067 tran_part_func = (
boltzmann*temp)**2.5_dp/(pressure*(
h_bar*2.0_dp*
pi)**3.0_dp)*(2.0_dp*
pi*mass_tot)**1.5_dp
1074 vib_part_func = 1.0_dp
1076 vib_entropy = 0.0_dp
1081 freq_arg = fact*freqs(i)
1082 freq_arg2 = fact2*freqs(i)
1083 exp_min_one = exp(freq_arg) - 1.0_dp
1084 one_min_exp = 1.0_dp - exp(-freq_arg)
1092 vib_part_func = vib_part_func*(1.0_dp/one_min_exp)
1094 vib_energy = vib_energy + freq_arg2*0.5_dp + freq_arg2/exp_min_one
1096 vib_entropy = vib_entropy + freq_arg/exp_min_one - log(one_min_exp)
1098 vib_cv = vib_cv + freq_arg*freq_arg*exp(freq_arg)/exp_min_one/exp_min_one
1107 partition_function = rot_part_func*tran_part_func*vib_part_func
1111 entropy = el_entropy + rot_entropy + tran_entropy + vib_entropy
1115 rotvibtra = rot_energy + tran_enthalpy + vib_energy
1118 heat_capacity = vib_cv + tran_cv + rot_cv
1121 gibbs = vib_energy + rot_energy + tran_enthalpy - temp*entropy
1123 DEALLOCATE (mass_kg)
1126 WRITE (unit=iw, fmt=
"(/,T2,'VIB|',T30,'NORMAL MODES - THERMOCHEMICAL DATA')")
1127 WRITE (unit=iw, fmt=
"(T2,'VIB|',T16,'[q = gamma only, rigid-rotor harmonic oscillator (RRHO) model]')")
1129 WRITE (unit=iw, fmt=
"(/,T2,'VIB|', T10, 'Symmetry number:',T65,I16)") sym_num
1130 WRITE (unit=iw, fmt=
"(T2,'VIB|', T10, 'Temperature [K]:',T65,F16.2)") temp
1131 WRITE (unit=iw, fmt=
"(T2,'VIB|', T10, 'Pressure [Pa]:',T65,F16.2)") pressure
1133 WRITE (unit=iw, fmt=
"(/,T2,'VIB|', T10, 'Electronic energy (U) [kJ/mol]:',T55,F26.8)") totene*
kjmol
1134 WRITE (unit=iw, fmt=
"(T2,'VIB|', T10, 'Zero-point correction [kJ/mol]:',T55,F26.8)") zpe/1000.0_dp
1135 WRITE (unit=iw, fmt=
"(T2,'VIB|', T10, 'Entropy [kJ/(mol K)]:',T55,F26.8)") entropy/1000.0_dp
1136 WRITE (unit=iw, fmt=
"(T2,'VIB|', T10, 'Enthalpy correction (H-U) [kJ/mol]:',T55,F26.8)") rotvibtra/1000.0_dp
1137 WRITE (unit=iw, fmt=
"(T2,'VIB|', T10, 'Gibbs energy correction [kJ/mol]:',T55,F26.8)") gibbs/1000.0_dp
1138 WRITE (unit=iw, fmt=
"(T2,'VIB|', T10, 'Heat capacity [kJ/(mol*K)]:',T65,F16.8)") heat_capacity/1000.0_dp
1139 WRITE (unit=iw, fmt=
"(/)")
1142 END SUBROUTINE get_thch_values
1153 SUBROUTINE write_eigs_unformatted(unit, dof, eigenvalues, eigenvectors)
1154 INTEGER,
INTENT(IN) :: unit, dof
1155 REAL(kind=
dp),
DIMENSION(:),
INTENT(IN) :: eigenvalues
1156 REAL(kind=
dp),
DIMENSION(:, :),
INTENT(IN) :: eigenvectors
1158 CHARACTER(len=*),
PARAMETER :: routinen =
'write_eigs_unformatted'
1160 INTEGER :: handle, jj
1162 CALL timeset(routinen, handle)
1167 WRITE (unit) eigenvalues(1:dof)
1170 WRITE (unit) eigenvectors(1:dof, jj)
1173 CALL timestop(handle)
1175 END SUBROUTINE write_eigs_unformatted
1186 SUBROUTINE write_va_hessian(vib_section, para_env, ncoord, globenv, Hessian, logger)
1192 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:, :) :: hessian
1195 CHARACTER(LEN=*),
PARAMETER :: routinen =
'write_va_hessian'
1197 INTEGER :: handle, hesunit, i, j, ndf
1202 CALL timeset(routinen, handle)
1205 extension=
".hess", file_form=
"UNFORMATTED", file_action=
"WRITE", &
1206 file_position=
"REWIND")
1210 globenv%blacs_repeatable)
1213 nrow_global=ndf, ncol_global=ndf)
1214 CALL cp_fm_create(hess_mat, fm_struct_hes, name=
"hess_mat")
1230 CALL timestop(handle)
1232 END SUBROUTINE write_va_hessian
Define the atomic kind types and their sub types.
subroutine, public get_atomic_kind(atomic_kind, fist_potential, element_symbol, name, mass, kind_number, natom, atom_list, rcov, rvdw, z, qeff, apol, cpol, mm_radius, shell, shell_active, damping)
Get attributes of an atomic kind.
methods related to the blacs parallel environment
subroutine, public cp_blacs_env_release(blacs_env)
releases the given blacs_env
subroutine, public cp_blacs_env_create(blacs_env, para_env, blacs_grid_layout, blacs_repeatable, row_major, grid_2d)
allocates and initializes a type that represent a blacs context
represent the structure of a full matrix
subroutine, public cp_fm_struct_create(fmstruct, para_env, context, nrow_global, ncol_global, nrow_block, ncol_block, descriptor, first_p_pos, local_leading_dimension, template_fmstruct, square_blocks, force_block)
allocates and initializes a full matrix structure
subroutine, public cp_fm_struct_release(fmstruct)
releases a full matrix structure
represent a full matrix distributed on many processors
subroutine, public cp_fm_create(matrix, matrix_struct, name, use_sp, nrow, ncol, set_zero)
creates a new full matrix with the given structure
subroutine, public cp_fm_write_unformatted(fm, unit)
...
subroutine, public cp_fm_set_all(matrix, alpha, beta)
set all elements of a matrix to the same value, and optionally the diagonal to a different one
subroutine, public cp_fm_set_element(matrix, irow_global, icol_global, alpha)
sets an element of a matrix
various routines to log and control the output. The idea is that decisions about where to log should ...
integer function, public cp_logger_get_default_io_unit(logger)
returns the unit nr for the ionode (-1 on all other processors) skips as well checks if the procs cal...
type(cp_logger_type) function, pointer, public cp_get_default_logger()
returns the default logger
routines to handle the output, The idea is to remove the decision of wheter to output and what to out...
integer function, public cp_print_key_unit_nr(logger, basis_section, print_key_path, extension, middle_name, local, log_filename, ignore_should_output, file_form, file_position, file_action, file_status, do_backup, on_file, is_new_file, mpi_io, fout)
...
subroutine, public cp_print_key_finished_output(unit_nr, logger, basis_section, print_key_path, local, ignore_should_output, on_file, mpi_io)
should be called after you finish working with a unit obtained with cp_print_key_unit_nr,...
set of type/routines to handle the storage of results in force_envs
logical function, public test_for_result(results, description)
test for a certain result in the result_list
types that represent a subsys, i.e. a part of the system
subroutine, public cp_subsys_get(subsys, ref_count, atomic_kinds, atomic_kind_set, particles, particle_set, local_particles, molecules, molecule_set, molecule_kinds, molecule_kind_set, local_molecules, para_env, colvar_p, shell_particles, core_particles, gci, multipoles, natom, nparticle, ncore, nshell, nkind, atprop, virial, results, cell, cell_ref, use_ref_cell)
returns information about various attributes of the given subsys
interface to use cp2k as library
subroutine, public f_env_add_defaults(f_env_id, f_env, handle)
adds the default environments of the f_env to the stack of the defaults, and returns a new error and ...
subroutine, public f_env_rm_defaults(f_env, ierr, handle)
removes the default environments of the f_env to the stack of the defaults, and sets ierr accordingly...
Interface for the force calculations.
recursive subroutine, public force_env_get(force_env, in_use, fist_env, qs_env, meta_env, fp_env, subsys, para_env, potential_energy, additional_potential, kinetic_energy, harmonic_shell, kinetic_shell, cell, sub_force_env, qmmm_env, qmmmx_env, eip_env, pwdft_env, globenv, input, force_env_section, method_name_id, root_section, mixed_env, nnp_env, embed_env, ipi_env)
returns various attributes about the force environment
Define type storing the global information of a run. Keep the amount of stored data small....
subroutine, public write_grrm(iounit, force_env, particles, energy, dipole, hessian, dipder, polar, fixed_atoms)
Write GRRM interface file.
Defines the basic variable types.
integer, parameter, public dp
integer, parameter, public default_string_length
An array-based list which grows on demand. When the internal array is full, a new array of twice the ...
Definition of mathematical constants and functions.
real(kind=dp), parameter, public pi
Collection of simple mathematical functions and subroutines.
subroutine, public diamat_all(a, eigval, dac)
Diagonalize the symmetric n by n matrix a using the LAPACK library. Only the upper triangle of matrix...
Interface to the message passing library MPI.
Module performing a mdoe selective vibrational analysis.
subroutine, public ms_vb_anal(input, rep_env, para_env, globenv, particles, nrep, calc_intens, dx, output_unit, logger)
Module performing a vibrational analysis.
Functions handling the MOLDEN format. Split from mode_selective.
subroutine, public write_vibrations_molden(input, particles, freq, eigen_vec, intensities, calc_intens, dump_only_positive, logger, list)
writes the output for vibrational analysis in MOLDEN format
represent a simple array based list of the given type
Define the molecule kind structure types and the corresponding functionality.
subroutine, public get_molecule_kind(molecule_kind, atom_list, bond_list, bend_list, ub_list, impr_list, opbend_list, colv_list, fixd_list, g3x3_list, g4x6_list, vsite_list, torsion_list, shell_list, name, mass, charge, kind_number, natom, nbend, nbond, nub, nimpr, nopbend, nconstraint, nconstraint_fixd, nfixd, ncolv, ng3x3, ng4x6, nvsite, nfixd_restraint, ng3x3_restraint, ng4x6_restraint, nvsite_restraint, nrestraints, nmolecule, nsgf, nshell, ntorsion, molecule_list, nelectron, nelectron_alpha, nelectron_beta, bond_kind_set, bend_kind_set, ub_kind_set, impr_kind_set, opbend_kind_set, torsion_kind_set, molname_generated)
Get informations about a molecule kind.
Output Utilities for MOTION_SECTION.
real(kind=dp), parameter, public thrs_motion
subroutine, public rot_ana(particles, mat, dof, print_section, keep_rotations, mass_weighted, natoms, rot_dof, inertia)
Performs an analysis of the principal inertia axis Getting back the generators of the translating and...
represent a simple array based list of the given type
Define methods related to particle_type.
subroutine, public write_particle_matrix(matrix, particle_set, iw, el_per_part, ilist, parts_per_line)
...
Define the data structure for the particle information.
Definition of physical constants:
real(kind=dp), parameter, public boltzmann
real(kind=dp), parameter, public a_bohr
real(kind=dp), parameter, public vibfac
real(kind=dp), parameter, public n_avogadro
real(kind=dp), parameter, public c_light
real(kind=dp), parameter, public joule
real(kind=dp), parameter, public kelvin
real(kind=dp), parameter, public h_bar
real(kind=dp), parameter, public hertz
real(kind=dp), parameter, public angstrom
real(kind=dp), parameter, public e_mass
real(kind=dp), parameter, public wavenumbers
real(kind=dp), parameter, public massunit
real(kind=dp), parameter, public kjmol
real(kind=dp), parameter, public pascal
real(kind=dp), parameter, public bohr
real(kind=dp), parameter, public debye
methods to setup replicas of the same system differing only by atom positions and velocities (as used...
subroutine, public rep_env_create(rep_env, para_env, input, input_declaration, nrep, prep, sync_v, keep_wf_history, row_force)
creates a replica environment together with its force environment
subroutine, public rep_env_calc_e_f(rep_env, calc_f)
evaluates the forces
types used to handle many replica of the same system that differ only in atom positions,...
subroutine, public rep_env_release(rep_env)
releases the given replica environment
subroutine, public write_scine(iounit, force_env, particles, energy, hessian)
Write SCINE interface file.
All kind of helpful little routines.
Module performing a vibrational analysis.
subroutine, public vb_anal(input, input_declaration, para_env, globenv)
Module performing a vibrational analysis.
represent a blacs multidimensional parallel environment (for the mpi corrispective see cp_paratypes/m...
keeps the information about the structure of a full matrix
type of a logger, at the moment it contains just a print level starting at which level it should be l...
represents a system: atoms, molecules, their pos,vel,...
wrapper to abstract the force evaluation of the various methods
contains the initially parsed file and the initial parallel environment
stores all the informations relevant to an mpi environment
represent a list of objects
represent a list of objects
keeps replicated information about the replicas