75 a_bohr,
angstrom,
bohr,
boltzmann,
c_light,
debye,
e_mass,
h_bar,
hertz,
joule,
kelvin, &
83#include "../base/base_uses.f90"
87 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'vibrational_analysis'
88 LOGICAL,
PARAMETER :: debug_this_module = .false.
102 SUBROUTINE vb_anal(input, input_declaration, para_env, globenv)
108 CHARACTER(len=*),
PARAMETER :: routinen =
'vb_anal'
109 CHARACTER(LEN=1),
DIMENSION(3),
PARAMETER :: lab = [
"X",
"Y",
"Z"]
111 CHARACTER(LEN=default_string_length) :: description_d, description_p
112 INTEGER :: handle, i, icoord, icoordm, icoordp, ierr, imap, iounit, ip1, ip2, iparticle1, &
113 iparticle2, iseq, iw, j, k, natoms, ncoord, nfrozen, nrep, nres, nrottrm, nvib, &
114 output_unit, output_unit_eig, prep, print_grrm, print_namd, print_scine, proc_dist_type
115 INTEGER,
DIMENSION(:),
POINTER :: clist, mlist
116 LOGICAL :: calc_intens, calc_thchdata, do_mode_tracking, intens_ir, intens_raman, &
117 keep_rotations, row_force, something_frozen
118 REAL(kind=
dp) :: a1, a2, a3, conver, dummy, dx, &
119 inertia(3), minimum_energy, norm, &
120 tc_press, tc_temp, tmp
121 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:) :: h_eigval1, h_eigval2, heigvaldfull, &
122 konst, mass, pos0, rmass
123 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:, :) :: hessian, hessian_umw, hint1, hint2, &
125 REAL(kind=
dp),
DIMENSION(3) :: d_deriv, d_print
126 REAL(kind=
dp),
DIMENSION(3, 3) :: p_deriv, p_print
127 REAL(kind=
dp),
DIMENSION(:),
POINTER :: depol_p, depol_u, depp, depu, din, &
128 intensities_d, intensities_p, pin
129 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: d, dfull, dip_deriv, rottrm
130 REAL(kind=
dp),
DIMENSION(:, :, :),
POINTER :: polar_deriv, tmp_dip
131 REAL(kind=
dp),
DIMENSION(:, :, :, :),
POINTER :: tmp_polar
139 mode_tracking_section, print_section, &
142 CALL timeset(routinen, handle)
143 NULLIFY (d, rottrm, cell, logger, subsys, f_env, particles, rep_env, intensities_d, intensities_p, &
144 vib_section, print_section, depol_p, depol_u)
150 "PROGRAM_RUN_INFO", &
159 file_status=
"REPLACE", &
160 file_action=
"WRITE", &
162 file_form=
"UNFORMATTED")
175 tc_press = tc_press*
pascal
178 intens_raman = .false.
182 nrep = max(1, para_env%num_pe/prep)
183 prep = para_env%num_pe/nrep
191 input_declaration=input_declaration, nrep=nrep, prep=prep, row_force=row_force)
192 IF (
ASSOCIATED(rep_env))
THEN
196 particles => subsys%particles%els
198 IF (do_mode_tracking)
THEN
199 CALL ms_vb_anal(input, rep_env, para_env, globenv, particles, &
200 nrep, calc_intens, dx, output_unit, logger, cell)
203 CALL get_moving_atoms(force_env=f_env%force_env, ilist=mlist)
204 something_frozen =
SIZE(particles) /=
SIZE(mlist)
207 ALLOCATE (clist(ncoord))
208 ALLOCATE (mass(natoms))
209 ALLOCATE (pos0(ncoord))
210 ALLOCATE (hessian(ncoord, ncoord))
211 ALLOCATE (hessian_umw(ncoord, ncoord))
212 IF (calc_intens)
THEN
213 description_d =
'[DIPOLE]'
214 ALLOCATE (tmp_dip(ncoord, 3, 2))
216 description_p =
'[POLAR]'
217 ALLOCATE (tmp_polar(ncoord, 3, 3, 2))
223 clist((i - 1)*3 + 1) = (imap - 1)*3 + 1
224 clist((i - 1)*3 + 2) = (imap - 1)*3 + 2
225 clist((i - 1)*3 + 3) = (imap - 1)*3 + 3
226 mass(i) = particles(imap)%atomic_kind%mass
227 cpassert(mass(i) > 0.0_dp)
228 mass(i) = sqrt(mass(i))
229 pos0((i - 1)*3 + 1) = particles(imap)%r(1)
230 pos0((i - 1)*3 + 2) = particles(imap)%r(2)
231 pos0((i - 1)*3 + 3) = particles(imap)%r(3)
237 IF (something_frozen)
THEN
239 ALLOCATE (rottrm(natoms*3, nrottrm))
241 CALL rot_ana(particles, rottrm, nrottrm, print_section, &
242 keep_rotations, mass_weighted=.true., natoms=natoms, inertia=inertia)
245 nvib = 3*natoms - nrottrm
248 ALLOCATE (d(3*natoms, 3*natoms))
250 ALLOCATE (d(3*natoms, nvib))
252 CALL build_d_matrix(rottrm, nrottrm, d, full=.false., &
257 hessian = huge(0.0_dp)
258 hessian_umw = huge(0.0_dp)
259 IF (output_unit > 0)
WRITE (output_unit,
'(/,T2,A)')
"VIB| Vibrational Analysis Info"
260 DO icoordp = 1, ncoord, nrep
265 rep_env%r(imap, j) = pos0(i)
267 IF (icoord + j <= ncoord)
THEN
268 imap = clist(icoord + j)
269 rep_env%r(imap, j) = rep_env%r(imap, j) + dx
275 IF (calc_intens)
THEN
276 IF (icoord + j <= ncoord)
THEN
278 description=description_d))
THEN
279 CALL get_results(results=rep_env%results(j)%results, &
280 description=description_d, &
282 CALL get_results(results=rep_env%results(j)%results, &
283 description=description_d, &
284 values=tmp_dip(icoord + j, :, 1), &
287 d_print(:) = tmp_dip(icoord + j, :, 1)
290 description=description_p))
THEN
291 CALL get_results(results=rep_env%results(j)%results, &
292 description=description_p, &
294 CALL get_results(results=rep_env%results(j)%results, &
295 description=description_p, &
296 values=tmp_polar(icoord + j, :, :, 1), &
298 intens_raman = .true.
299 p_print(:, :) = tmp_polar(icoord + j, :, :, 1)
303 IF (icoord + j <= ncoord)
THEN
306 hessian(i, icoord + j) = rep_env%f(imap, j)
308 imap = clist(icoord + j)
310 IF (output_unit > 0)
THEN
312 IF (mod(imap, 3) /= 0) iparticle1 = iparticle1 + 1
313 WRITE (output_unit,
'(T2,A,I5,A,I5,3A)') &
314 "VIB| REPLICA Nr.", j,
"- Energy and Forces for particle:", &
315 iparticle1,
" coordinate: ", lab(imap - (iparticle1 - 1)*3), &
316 " + D"//trim(lab(imap - (iparticle1 - 1)*3))
317 WRITE (output_unit,
'(T2,A,T43,A,T57,F24.12)') &
318 "VIB|",
"Total energy:", rep_env%f(rep_env%ndim + 1, j)
319 WRITE (output_unit,
'(T2,"VIB|",T10,"ATOM",T33,3(9X,A,7X))') lab(1), lab(2), lab(3)
322 WRITE (output_unit,
'(T2,"VIB|",T12,A,T30,3(2X,F15.9))') &
323 particles(imap)%atomic_kind%name, &
324 rep_env%f((imap - 1)*3 + 1:(imap - 1)*3 + 3, j)
327 WRITE (output_unit,
'(T3,A)')
'Dipole moment [Debye]'
328 WRITE (output_unit,
'(T5,3(A,F14.8,1X),T60,A,T67,F14.8)') &
329 'X=', d_print(1)*
debye,
'Y=', d_print(2)*
debye,
'Z=', d_print(3)*
debye, &
330 'Total=', sqrt(sum(d_print(1:3)**2))*
debye
332 IF (intens_raman)
THEN
333 WRITE (output_unit,
'(T2,A)') &
334 'POLAR| Polarizability tensor [a.u.]'
335 WRITE (output_unit,
'(T2,A,T24,3(1X,F18.12))') &
336 'POLAR| xx,yy,zz', p_print(1, 1), p_print(2, 2), p_print(3, 3)
337 WRITE (output_unit,
'(T2,A,T24,3(1X,F18.12))') &
338 'POLAR| xy,xz,yz', p_print(1, 2), p_print(1, 3), p_print(2, 3)
339 WRITE (output_unit,
'(T2,A,T24,3(1X,F18.12),/)') &
340 'POLAR| yx,zx,zy', p_print(2, 1), p_print(3, 1), p_print(3, 2)
346 DO icoordm = 1, ncoord, nrep
351 rep_env%r(imap, j) = pos0(i)
353 IF (icoord + j <= ncoord)
THEN
354 imap = clist(icoord + j)
355 rep_env%r(imap, j) = rep_env%r(imap, j) - dx
361 IF (calc_intens)
THEN
362 IF (icoord + j <= ncoord)
THEN
363 k = (icoord + j + 2)/3
365 description=description_d))
THEN
366 CALL get_results(results=rep_env%results(j)%results, &
367 description=description_d, &
369 CALL get_results(results=rep_env%results(j)%results, &
370 description=description_d, &
371 values=tmp_dip(icoord + j, :, 2), &
373 tmp_dip(icoord + j, :, 1) = (tmp_dip(icoord + j, :, 1) - &
374 tmp_dip(icoord + j, :, 2))/(2.0_dp*dx*mass(k))
375 d_print(:) = tmp_dip(icoord + j, :, 1)
378 description=description_p))
THEN
379 CALL get_results(results=rep_env%results(j)%results, &
380 description=description_p, &
382 CALL get_results(results=rep_env%results(j)%results, &
383 description=description_p, &
384 values=tmp_polar(icoord + j, :, :, 2), &
386 tmp_polar(icoord + j, :, :, 1) = (tmp_polar(icoord + j, :, :, 1) - &
387 tmp_polar(icoord + j, :, :, 2))/(2.0_dp*dx*mass(k))
388 p_print(:, :) = tmp_polar(icoord + j, :, :, 1)
392 IF (icoord + j <= ncoord)
THEN
393 imap = clist(icoord + j)
395 IF (mod(imap, 3) /= 0) iparticle1 = iparticle1 + 1
397 IF (mod(icoord + j, 3) /= 0) ip1 = ip1 + 1
399 IF (output_unit > 0)
THEN
400 WRITE (output_unit,
'(T2,A,I5,A,I5,3A)') &
401 "VIB| REPLICA Nr.", j,
"- Energy and Forces for particle:", &
402 iparticle1,
" coordinate: ", lab(imap - (iparticle1 - 1)*3), &
403 " - D"//trim(lab(imap - (iparticle1 - 1)*3))
404 WRITE (output_unit,
'(T2,A,T43,A,T57,F24.12)') &
405 "VIB|",
"Total energy:", rep_env%f(rep_env%ndim + 1, j)
406 WRITE (output_unit,
'(T2,"VIB|",T10,"ATOM",T33,3(9X,A,7X))') lab(1), lab(2), lab(3)
409 WRITE (output_unit,
'(T2,"VIB|",T12,A,T30,3(2X,F15.9))') &
410 particles(imap)%atomic_kind%name, &
411 rep_env%f((imap - 1)*3 + 1:(imap - 1)*3 + 3, j)
414 WRITE (output_unit,
'(T3,A)')
'Dipole moment [Debye]'
415 WRITE (output_unit,
'(T5,3(A,F14.8,1X),T60,A,T67,F14.8)') &
416 'X=', d_print(1)*
debye,
'Y=', d_print(2)*
debye,
'Z=', d_print(3)*
debye, &
417 'Total=', sqrt(sum(d_print(1:3)**2))*
debye
419 IF (intens_raman)
THEN
420 WRITE (output_unit,
'(T2,A)') &
421 'POLAR| Polarizability tensor [a.u.]'
422 WRITE (output_unit,
'(T2,A,T24,3(1X,F18.12))') &
423 'POLAR| xx,yy,zz', p_print(1, 1), p_print(2, 2), p_print(3, 3)
424 WRITE (output_unit,
'(T2,A,T24,3(1X,F18.12))') &
425 'POLAR| xy,xz,yz', p_print(1, 2), p_print(1, 3), p_print(2, 3)
426 WRITE (output_unit,
'(T2,A,T24,3(1X,F18.12),/)') &
427 'POLAR| yx,zx,zy', p_print(2, 1), p_print(3, 1), p_print(3, 2)
433 IF (mod(imap, 3) /= 0) iparticle2 = iparticle2 + 1
435 IF (mod(iseq, 3) /= 0) ip2 = ip2 + 1
436 tmp = hessian(iseq, icoord + j) - rep_env%f(imap, j)
439 hessian_umw(iseq, icoord + j) = -tmp/(2.0_dp*dx)
440 hessian(iseq, icoord + j) = hessian_umw(iseq, icoord + j)*1e6_dp/(mass(ip1)*mass(ip2))
449 particles(imap)%r(1:3) = pos0((i - 1)*3 + 1:(i - 1)*3 + 3)
454 rep_env%r(imap, j) = pos0(i)
459 minimum_energy = rep_env%f(rep_env%ndim + 1, j)
460 IF (output_unit > 0)
THEN
461 WRITE (output_unit,
'(T2,A)') &
462 "VIB| ",
" Minimum Structure - Energy and Forces:"
463 WRITE (output_unit,
'(T2,A,T43,A,T57,F24.12)') &
464 "VIB|",
"Total energy:", rep_env%f(rep_env%ndim + 1, j)
465 WRITE (output_unit,
'(T2,"VIB|",T10,"ATOM",T33,3(9X,A,7X))') lab(1), lab(2), lab(3)
468 WRITE (output_unit,
'(T2,"VIB|",T12,A,T30,3(2X,F15.9))') &
469 particles(imap)%atomic_kind%name, &
470 rep_env%f((imap - 1)*3 + 1:(imap - 1)*3 + 3, j)
475 IF (output_unit > 0)
THEN
476 WRITE (output_unit,
'(/,T2,A)') &
477 "VIB| Hessian (before multiplying by 1E6/(sqrt(mass_i)*sqrt(mass_j)))"
480 WRITE (output_unit,
'(/,T2,A)') &
481 "VIB| Hessian in cartesian coordinates (mass weighted)"
486 CALL write_va_hessian(vib_section, para_env, ncoord, globenv, hessian, logger)
492 hessian(j, i) = hessian(i, j)
498 file_position=
"REWIND", extension=
".rrm")
499 IF (print_grrm > 0)
THEN
502 particles(imap)%f(1:3) = rep_env%f((imap - 1)*3 + 1:(imap - 1)*3 + 3, 1)
504 ALLOCATE (hint1(ncoord, ncoord), rmass(ncoord))
507 rmass(3*(imap - 1) + 1:3*(imap - 1) + 3) = mass(imap)
511 hint1(j, i) = hessian(j, i)*rmass(i)*rmass(j)*1.0e-6_dp
514 nfrozen =
SIZE(particles) - natoms
515 CALL write_grrm(print_grrm, f_env%force_env, particles, minimum_energy, &
516 hessian=hint1, fixed_atoms=nfrozen)
517 DEALLOCATE (hint1, rmass)
523 file_position=
"REWIND", extension=
".scine")
524 IF (print_scine > 0)
THEN
527 particles(imap)%f(1:3) = rep_env%f((imap - 1)*3 + 1:(imap - 1)*3 + 3, 1)
529 nfrozen =
SIZE(particles) - natoms
530 cpassert(nfrozen == 0)
531 CALL write_scine(print_scine, f_env%force_env, particles, minimum_energy, hessian=hessian)
537 extension=
".eig", file_status=
"REPLACE", &
538 file_action=
"WRITE", do_backup=.true., &
539 file_form=
"UNFORMATTED")
540 IF (print_namd > 0)
THEN
544 ALLOCATE (dfull(ncoord, ncoord))
545 ALLOCATE (hint2dfull(
SIZE(dfull, 2),
SIZE(dfull, 2)))
546 ALLOCATE (heigvaldfull(
SIZE(dfull, 2)))
547 ALLOCATE (matm(ncoord, ncoord))
548 ALLOCATE (rmass(
SIZE(dfull, 2)))
551 CALL build_d_matrix(rottrm, nrottrm, dfull, full=.true., natoms=natoms)
554 hint2dfull(:, :) = matmul(transpose(dfull), matmul(hessian, dfull))
562 matm((i - 1)*3 + j, (i - 1)*3 + j) = 1.0_dp/mass(i)
566 dfull = matmul(matm, matmul(dfull, hint2dfull))
569 norm = 1.0_dp/sum(dfull(:, i)*dfull(:, i))
571 dfull(:, i) = sqrt(norm)*(dfull(:, i))
573 CALL write_eigs_unformatted(print_namd, ncoord, heigvaldfull, dfull)
574 DEALLOCATE (heigvaldfull)
575 DEALLOCATE (hint2dfull)
581 nvib = ncoord - nrottrm
582 ALLOCATE (h_eigval1(ncoord))
583 ALLOCATE (h_eigval2(
SIZE(d, 2)))
584 ALLOCATE (hint1(ncoord, ncoord))
585 ALLOCATE (hint2(
SIZE(d, 2),
SIZE(d, 2)))
586 ALLOCATE (rmass(
SIZE(d, 2)))
587 ALLOCATE (konst(
SIZE(d, 2)))
588 IF (calc_intens)
THEN
589 ALLOCATE (dip_deriv(3,
SIZE(d, 2)))
591 ALLOCATE (polar_deriv(3, 3,
SIZE(d, 2)))
594 ALLOCATE (intensities_d(
SIZE(d, 2)))
595 ALLOCATE (intensities_p(
SIZE(d, 2)))
596 ALLOCATE (depol_p(
SIZE(d, 2)))
597 ALLOCATE (depol_u(
SIZE(d, 2)))
598 intensities_d = 0._dp
599 intensities_p = 0._dp
602 hint1(:, :) = hessian
604 IF (output_unit > 0)
THEN
605 WRITE (output_unit,
'(/,T2,A)')
"VIB| Cartesian Low frequencies ---"
607 WRITE (output_unit,
'(T2,A,T6,5(1X,ES14.7E2))') &
608 "VIB|", h_eigval1(i:min(i + 4, ncoord))
610 WRITE (output_unit,
'(/,T2,A)')
"VIB| Eigenvectors before removal of rotations and translations"
615 IF (output_unit_eig > 0)
THEN
616 CALL write_eigs_unformatted(output_unit_eig, ncoord, h_eigval1, hint1)
619 hint2(:, :) = matmul(transpose(d), matmul(hessian, d))
620 IF (calc_intens)
THEN
622 dip_deriv(i, :) = matmul(tmp_dip(:, i, 1), d)
626 polar_deriv(i, j, :) = matmul(tmp_polar(:, i, j, 1), d)
631 IF (output_unit > 0)
THEN
632 WRITE (output_unit,
'(/,T2,"VIB| Frequencies after removal of the rotations and translations")')
634 WRITE (output_unit,
'(/,T2,A)')
"VIB| Internal Low frequencies ---"
635 DO i = 1,
SIZE(d, 2), 5
636 WRITE (output_unit,
'(T2,A,T6,5(1X,ES14.7E2))') &
637 "VIB|", h_eigval2(i:min(i + 4,
SIZE(d, 2)))
643 hessian((i - 1)*3 + j, (i - 1)*3 + j) = 1.0_dp/mass(i)
647 d = matmul(hessian, matmul(d, hint2))
649 norm = 1.0_dp/sum(d(:, i)*d(:, i))
653 d(:, i) = sqrt(norm)*d(:, i)
654 IF (calc_intens)
THEN
657 d_deriv(:) = d_deriv(:) + dip_deriv(:, j)*hint2(j, i)
659 intensities_d(i) = norm2(d_deriv)
663 p_deriv(:, :) = p_deriv(:, :) + polar_deriv(:, :, j)*hint2(j, i)
667 p_deriv(:, :) = p_deriv(:, :)*conver
669 a1 = (p_deriv(1, 1) + p_deriv(2, 2) + p_deriv(3, 3))/3.0_dp
670 a2 = (p_deriv(1, 1) - p_deriv(2, 2))**2 + &
671 (p_deriv(2, 2) - p_deriv(3, 3))**2 + &
672 (p_deriv(3, 3) - p_deriv(1, 1))**2
673 a3 = (p_deriv(1, 2)**2 + p_deriv(2, 3)**2 + p_deriv(3, 1)**2)
674 intensities_p(i) = 45.0_dp*a1*a1 + 7.0_dp/2.0_dp*(a2 + 6.0_dp*a3)
676 dummy = 45.0_dp*a1*a1 + 4.0_dp/2.0_dp*(a2 + 6.0_dp*a3)
677 IF (dummy > 5.e-7_dp)
THEN
679 depol_p(i) = 3.0_dp/2.0_dp*(a2 + 6.0_dp*a3)/(45.0_dp*a1*a1 + &
680 4.0_dp/2.0_dp*(a2 + 6.0_dp*a3))
682 depol_u(i) = 6.0_dp/2.0_dp*(a2 + 6.0_dp*a3)/(45.0_dp*a1*a1 + &
683 7.0_dp/2.0_dp*(a2 + 6.0_dp*a3))
690 h_eigval2(i) = sign(1.0_dp, h_eigval2(i))*sqrt(abs(h_eigval2(i))*
massunit)*
vibfac/1000.0_dp
694 IF (calc_intens)
THEN
696 IF (.NOT. intens_ir)
THEN
697 WRITE (iounit,
'(T2,"VIB| No IR intensities available. Check input")')
699 IF (.NOT. intens_raman)
THEN
700 WRITE (iounit,
'(T2,"VIB| No Raman intensities available. Check input")')
707 NULLIFY (din, pin, depp, depu)
708 IF (intens_ir) din => intensities_d
709 IF (intens_raman) pin => intensities_p
710 IF (intens_raman) depp => depol_p
711 IF (intens_raman) depu => depol_u
712 CALL vib_out(iw, nvib, d, konst, rmass, h_eigval2, particles, mlist, din, pin, depp, depu)
714 IF (.NOT. something_frozen .AND. calc_thchdata)
THEN
715 CALL get_thch_values(h_eigval2, iw, mass, nvib, inertia, 1, minimum_energy, tc_temp, tc_press)
718 dump_only_positive=.false., logger=logger,
list=mlist, cell=cell)
720 IF (output_unit > 0)
THEN
721 WRITE (output_unit,
'(T2,"VIB| No further vibrational info. Detected a single atom")')
728 DEALLOCATE (h_eigval1)
729 DEALLOCATE (h_eigval2)
738 DEALLOCATE (hessian_umw)
739 IF (calc_intens)
THEN
740 DEALLOCATE (dip_deriv)
741 DEALLOCATE (polar_deriv)
743 DEALLOCATE (tmp_polar)
745 DEALLOCATE (intensities_d)
746 DEALLOCATE (intensities_p)
755 CALL timestop(handle)
764 SUBROUTINE get_moving_atoms(force_env, Ilist)
766 INTEGER,
DIMENSION(:),
POINTER :: ilist
768 CHARACTER(len=*),
PARAMETER :: routinen =
'get_moving_atoms'
770 INTEGER :: handle, i, ii, ikind, j, ndim, &
771 nfixed_atoms, nfixed_atoms_total, nkind
772 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: ifixd_list, work
781 CALL timeset(routinen, handle)
785 molecule_kinds=molecule_kinds)
787 nkind = molecule_kinds%n_els
788 molecule_kind_set => molecule_kinds%els
789 particle_set => particles%els
792 nfixed_atoms_total = 0
794 molecule_kind => molecule_kind_set(ikind)
796 nfixed_atoms_total = nfixed_atoms_total + nfixed_atoms
798 ndim =
SIZE(particle_set) - nfixed_atoms_total
800 ALLOCATE (ilist(ndim))
802 IF (nfixed_atoms_total /= 0)
THEN
803 ALLOCATE (ifixd_list(nfixed_atoms_total))
804 ALLOCATE (work(nfixed_atoms_total))
805 nfixed_atoms_total = 0
807 molecule_kind => molecule_kind_set(ikind)
809 IF (
ASSOCIATED(fixd_list))
THEN
810 DO ii = 1,
SIZE(fixd_list)
811 IF (.NOT. fixd_list(ii)%restraint%active)
THEN
812 nfixed_atoms_total = nfixed_atoms_total + 1
813 ifixd_list(nfixed_atoms_total) = fixd_list(ii)%fixd
818 CALL sort(ifixd_list, nfixed_atoms_total, work)
822 loop_count:
DO i = 1,
SIZE(particle_set)
823 DO WHILE (i > ifixd_list(j))
825 IF (j > nfixed_atoms_total)
EXIT loop_count
827 IF (i /= ifixd_list(j))
THEN
832 DEALLOCATE (ifixd_list)
838 DO j = i,
SIZE(particle_set)
842 CALL timestop(handle)
844 END SUBROUTINE get_moving_atoms
862 SUBROUTINE vib_out(iw, nvib, D, k, m, freq, particles, Mlist, intensities_d, intensities_p, &
864 INTEGER,
INTENT(IN) :: iw, nvib
865 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: d
866 REAL(kind=
dp),
DIMENSION(:),
INTENT(IN) :: k, m, freq
868 INTEGER,
DIMENSION(:),
POINTER :: mlist
869 REAL(kind=
dp),
DIMENSION(:),
POINTER :: intensities_d, intensities_p, depol_p, &
872 CHARACTER(LEN=2) :: element_symbol
873 INTEGER :: from, iatom, icol, j, jatom, katom, &
875 REAL(kind=
dp) :: fint, pint
880 WRITE (unit=iw, fmt=
"(/,T2,'VIB|',T30,'NORMAL MODES - CARTESIAN DISPLACEMENTS')")
881 WRITE (unit=iw, fmt=
"(T2,'VIB|')")
882 DO jatom = 1, nvib, 3
884 to = min(from + 2, nvib)
885 WRITE (unit=iw, fmt=
"(T2,'VIB|',13X,3(8X,I5,8X))") &
886 (icol, icol=from, to)
887 WRITE (unit=iw, fmt=
"(T2,'VIB|Frequency (cm^-1)',3(1X,ES17.10E2,2X))") &
888 (freq(icol), icol=from, to)
889 IF (
ASSOCIATED(intensities_d))
THEN
890 WRITE (unit=iw, fmt=
"(T2,'VIB|IR int (KM/Mole) ',3(1X,ES17.10E2,2X))") &
891 (fint*intensities_d(icol)**2, icol=from, to)
893 IF (
ASSOCIATED(intensities_p))
THEN
894 WRITE (unit=iw, fmt=
"(T2,'VIB|Raman (A^4/amu) ',3(1X,ES17.10E2,2X))") &
895 (pint*intensities_p(icol), icol=from, to)
896 WRITE (unit=iw, fmt=
"(T2,'VIB|Depol Ratio (P) ',3(1X,ES17.10E2,2X))") &
897 (depol_p(icol), icol=from, to)
898 WRITE (unit=iw, fmt=
"(T2,'VIB|Depol Ratio (U) ',3(1X,ES17.10E2,2X))") &
899 (depol_u(icol), icol=from, to)
901 WRITE (unit=iw, fmt=
"(T2,'VIB|Red.Masses (a.u.)',3(1X,ES17.10E2,2X))") &
902 (m(icol), icol=from, to)
903 WRITE (unit=iw, fmt=
"(T2,'VIB|Frc consts (a.u.)',3(1X,ES17.10E2,2X))") &
904 (k(icol), icol=from, to)
905 WRITE (unit=iw, fmt=
"(T2,' ATOM',2X,'EL',10X,3(3X,' X ',1X,' Y ',1X,' Z '))")
906 DO iatom = 1, natom, 3
908 IF (mod(iatom, 3) /= 0) katom = katom + 1
909 CALL get_atomic_kind(atomic_kind=particles(mlist(katom))%atomic_kind, &
910 element_symbol=element_symbol)
911 WRITE (unit=iw, fmt=
"(T2,I5,2X,A2,10X,3(3X,2(F5.2,1X),F5.2))") &
912 mlist(katom), element_symbol, &
913 ((d(iatom + j, icol), j=0, 2), icol=from, to)
915 WRITE (unit=iw, fmt=
"(/)")
918 END SUBROUTINE vib_out
930 SUBROUTINE build_d_matrix(mat, dof, Dout, full, natoms)
931 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: mat
932 INTEGER,
INTENT(IN) :: dof
933 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: dout
934 LOGICAL,
OPTIONAL :: full
935 INTEGER,
INTENT(IN) :: natoms
937 CHARACTER(len=*),
PARAMETER :: routinen =
'build_D_matrix'
939 INTEGER :: handle, i, ifound, iseq, j, nvib
941 REAL(kind=
dp) :: norm
942 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:) :: work
943 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:, :) :: d
945 CALL timeset(routinen, handle)
947 IF (
PRESENT(full)) my_full = full
949 nvib = 3*natoms - dof
950 ALLOCATE (work(3*natoms))
951 ALLOCATE (d(3*natoms, 3*natoms))
956 norm = dot_product(mat(:, i), mat(:, j))
958 cpwarn(
"Orthogonality error in transformation matrix")
965 DO WHILE (ifound /= nvib)
967 cpassert(iseq <= 3*natoms)
971 DO i = 1, dof + ifound
972 norm = dot_product(work, d(:, i))
973 work(:) = work - norm*d(:, i)
980 d(:, dof + ifound) = work/norm
983 cpassert(dof + ifound == 3*natoms)
987 dout = d(:, dof + 1:)
991 CALL timestop(handle)
992 END SUBROUTINE build_d_matrix
1009 SUBROUTINE get_thch_values(freqs, iw, mass, nvib, inertia, spin, totene, temp, pressure)
1011 REAL(kind=
dp),
DIMENSION(:) :: freqs
1012 INTEGER,
INTENT(IN) :: iw
1013 REAL(kind=
dp),
DIMENSION(:) :: mass
1014 INTEGER,
INTENT(IN) :: nvib
1015 REAL(kind=
dp),
INTENT(IN) :: inertia(3)
1016 INTEGER,
INTENT(IN) :: spin
1017 REAL(kind=
dp),
INTENT(IN) :: totene, temp, pressure
1019 INTEGER :: i, natoms, sym_num
1020 REAL(kind=
dp) :: el_entropy, entropy, exp_min_one, fact, fact2, freq_arg, freq_arg2, &
1021 freqsum, gibbs, heat_capacity, inertia_kg(3), mass_tot, one_min_exp, partition_function, &
1022 rot_cv, rot_energy, rot_entropy, rot_part_func, rotvibtra, tran_cv, tran_energy, &
1023 tran_enthalpy, tran_entropy, tran_part_func, vib_cv, vib_energy, vib_entropy, &
1025 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:) :: mass_kg
1032 freqsum = freqsum + freqs(i)
1041 ALLOCATE (mass_kg(natoms))
1042 mass_kg(:) = mass(:)**2*
e_mass
1043 mass_tot = sum(mass_kg)
1049 IF (inertia_kg(1)*inertia_kg(2)*inertia_kg(3) > 1.0_dp)
THEN
1050 rot_part_func = fact*fact*fact*inertia_kg(1)*inertia_kg(2)*inertia_kg(3)*
pi
1051 rot_part_func = sqrt(rot_part_func)
1057 IF (inertia_kg(1) > 1.0_dp)
THEN
1058 rot_part_func = fact*inertia_kg(1)
1059 ELSE IF (inertia_kg(2) > 1.0_dp)
THEN
1060 rot_part_func = fact*inertia_kg(2)
1062 rot_part_func = fact*inertia_kg(3)
1070 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
1077 vib_part_func = 1.0_dp
1079 vib_entropy = 0.0_dp
1084 freq_arg = fact*freqs(i)
1085 freq_arg2 = fact2*freqs(i)
1086 exp_min_one = exp(freq_arg) - 1.0_dp
1087 one_min_exp = 1.0_dp - exp(-freq_arg)
1095 vib_part_func = vib_part_func*(1.0_dp/one_min_exp)
1097 vib_energy = vib_energy + freq_arg2*0.5_dp + freq_arg2/exp_min_one
1099 vib_entropy = vib_entropy + freq_arg/exp_min_one - log(one_min_exp)
1101 vib_cv = vib_cv + freq_arg*freq_arg*exp(freq_arg)/exp_min_one/exp_min_one
1110 partition_function = rot_part_func*tran_part_func*vib_part_func
1114 entropy = el_entropy + rot_entropy + tran_entropy + vib_entropy
1118 rotvibtra = rot_energy + tran_enthalpy + vib_energy
1121 heat_capacity = vib_cv + tran_cv + rot_cv
1124 gibbs = vib_energy + rot_energy + tran_enthalpy - temp*entropy
1126 DEALLOCATE (mass_kg)
1129 WRITE (unit=iw, fmt=
"(/,T2,'VIB|',T30,'NORMAL MODES - THERMOCHEMICAL DATA')")
1130 WRITE (unit=iw, fmt=
"(T2,'VIB|',T16,'[q = gamma only, rigid-rotor harmonic oscillator (RRHO) model]')")
1132 WRITE (unit=iw, fmt=
"(/,T2,'VIB|', T10, 'Symmetry number:',T65,I16)") sym_num
1133 WRITE (unit=iw, fmt=
"(T2,'VIB|', T10, 'Temperature [K]:',T65,F16.2)") temp
1134 WRITE (unit=iw, fmt=
"(T2,'VIB|', T10, 'Pressure [Pa]:',T65,F16.2)") pressure
1136 WRITE (unit=iw, fmt=
"(/,T2,'VIB|', T10, 'Electronic energy (U) [kJ/mol]:',T55,F26.8)") totene*
kjmol
1137 WRITE (unit=iw, fmt=
"(T2,'VIB|', T10, 'Zero-point correction [kJ/mol]:',T55,F26.8)") zpe/1000.0_dp
1138 WRITE (unit=iw, fmt=
"(T2,'VIB|', T10, 'Entropy [kJ/(mol K)]:',T55,F26.8)") entropy/1000.0_dp
1139 WRITE (unit=iw, fmt=
"(T2,'VIB|', T10, 'Enthalpy correction (H-U) [kJ/mol]:',T55,F26.8)") rotvibtra/1000.0_dp
1140 WRITE (unit=iw, fmt=
"(T2,'VIB|', T10, 'Gibbs energy correction [kJ/mol]:',T55,F26.8)") gibbs/1000.0_dp
1141 WRITE (unit=iw, fmt=
"(T2,'VIB|', T10, 'Heat capacity [kJ/(mol*K)]:',T65,F16.8)") heat_capacity/1000.0_dp
1142 WRITE (unit=iw, fmt=
"(/)")
1145 END SUBROUTINE get_thch_values
1156 SUBROUTINE write_eigs_unformatted(unit, dof, eigenvalues, eigenvectors)
1157 INTEGER,
INTENT(IN) :: unit, dof
1158 REAL(kind=
dp),
DIMENSION(:),
INTENT(IN) :: eigenvalues
1159 REAL(kind=
dp),
DIMENSION(:, :),
INTENT(IN) :: eigenvectors
1161 CHARACTER(len=*),
PARAMETER :: routinen =
'write_eigs_unformatted'
1163 INTEGER :: handle, jj
1165 CALL timeset(routinen, handle)
1170 WRITE (unit) eigenvalues(1:dof)
1173 WRITE (unit) eigenvectors(1:dof, jj)
1176 CALL timestop(handle)
1178 END SUBROUTINE write_eigs_unformatted
1189 SUBROUTINE write_va_hessian(vib_section, para_env, ncoord, globenv, Hessian, logger)
1195 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:, :) :: hessian
1198 CHARACTER(LEN=*),
PARAMETER :: routinen =
'write_va_hessian'
1200 INTEGER :: handle, hesunit, i, j, ndf
1205 CALL timeset(routinen, handle)
1208 extension=
".hess", file_form=
"UNFORMATTED", file_action=
"WRITE", &
1209 file_position=
"REWIND")
1213 globenv%blacs_repeatable)
1216 nrow_global=ndf, ncol_global=ndf)
1217 CALL cp_fm_create(hess_mat, fm_struct_hes, name=
"hess_mat")
1233 CALL timestop(handle)
1235 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.
Handles all functions related to the CELL.
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_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_create(matrix, matrix_struct, name, nrow, ncol, set_zero)
creates a new full matrix with the given structure
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, cell)
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, cell)
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.
Type defining parameters related to the simulation cell.
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