diff --git a/src/freq/io.f90 b/src/freq/io.f90 index 3efbe81b6..014ed2e9f 100644 --- a/src/freq/io.f90 +++ b/src/freq/io.f90 @@ -27,386 +27,386 @@ module xtb_freq_io contains !> Write the second derivative matrix - subroutine writeHessianOut(fname, hessian) +subroutine writeHessianOut(fname, hessian) - !> File name - character(len=*), intent(in) :: fname + !> File name + character(len=*), intent(in) :: fname - !> Dynamical (Hessian) matrix - real(wp), intent(in) :: hessian(:, :) + !> Dynamical (Hessian) matrix + real(wp), intent(in) :: hessian(:, :) - !> Format string for energy second derivative matrix - character(len=*), parameter :: fmt = '(4f16.10)' + !> Format string for energy second derivative matrix + character(len=*), parameter :: fmt = '(4f16.10)' - integer :: ii, id + integer :: ii, id - call open_file(id, fname, 'w') - do ii = 1, size(hessian, dim=2) - write (id, fmt) hessian(:, ii) - end do - call close_file(id) - - end subroutine writeHessianOut - - subroutine wrhess(nat3, h, fname) - integer, intent(in) :: nat3 - real(wp), intent(in) :: h(nat3 * (nat3 + 1) / 2) - character(len=*), intent(in) :: fname - integer iunit, i, j, mincol, maxcol, k - character(len=5) :: adum - character(len=80) :: a80 - - adum = ' ' - call open_file(iunit, fname, 'w') - a80 = '$hessian' - write (iunit, '(a)') a80 + call open_file(id, fname, 'w') + do ii = 1, size(hessian, dim=2) + write (id, fmt) hessian(:, ii) + end do + call close_file(id) + +end subroutine writeHessianOut + +subroutine wrhess(nat3, h, fname) + integer, intent(in) :: nat3 + real(wp), intent(in) :: h(nat3 * (nat3 + 1) / 2) + character(len=*), intent(in) :: fname + integer iunit, i, j, mincol, maxcol, k + character(len=5) :: adum + character(len=80) :: a80 + + adum = ' ' + call open_file(iunit, fname, 'w') + a80 = '$hessian' + write (iunit, '(a)') a80 + do i = 1, nat3 + maxcol = 0 + k = 0 +200 mincol = maxcol + 1 + k = k + 1 + maxcol = min(maxcol + 5, nat3) + write (iunit, '(a5,5f15.10)') adum, (h(lin(i, j)), j=mincol, maxcol) + if (maxcol < nat3) goto 200 + end do + call close_file(iunit) + +end subroutine wrhess + +subroutine rdhess(nat3, h, fname) + integer, intent(in) :: nat3 + real(wp), intent(out) :: h(nat3, nat3) + character(len=*), intent(in) :: fname + integer :: iunit, i, j, mincol, maxcol + character(len=5) :: adum + character(len=80) :: a80 + + ! write(*,*) 'Reading Hessian <',trim(fname),'>' + call open_file(iunit, fname, 'r') +50 read (iunit, '(a)') a80 + if (index(a80, '$hessian') /= 0) then do i = 1, nat3 maxcol = 0 - k = 0 -200 mincol = maxcol + 1 - k = k + 1 +200 mincol = maxcol + 1 maxcol = min(maxcol + 5, nat3) - write (iunit, '(a5,5f15.10)') adum, (h(lin(i, j)), j=mincol, maxcol) + read (iunit, *) (h(j, i), j=mincol, maxcol) if (maxcol < nat3) goto 200 end do call close_file(iunit) - - end subroutine wrhess - - subroutine rdhess(nat3, h, fname) - integer, intent(in) :: nat3 - real(wp), intent(out) :: h(nat3, nat3) - character(len=*), intent(in) :: fname - integer :: iunit, i, j, mincol, maxcol - character(len=5) :: adum - character(len=80) :: a80 - - ! write(*,*) 'Reading Hessian <',trim(fname),'>' - call open_file(iunit, fname, 'r') -50 read (iunit, '(a)') a80 - if (index(a80, '$hessian') /= 0) then - do i = 1, nat3 - maxcol = 0 -200 mincol = maxcol + 1 - maxcol = min(maxcol + 5, nat3) - read (iunit, *) (h(j, i), j=mincol, maxcol) - if (maxcol < nat3) goto 200 - end do - call close_file(iunit) - goto 300 - end if - goto 50 + goto 300 + end if + goto 50 300 return - end subroutine rdhess - - subroutine write_tm_vibspectrum(ich, n3, freq, ir_int, raman_activity, temp, v_incident) - use xtb_setparam - use xtb_mctc_constants - use xtb_mctc_convert - integer, intent(in) :: ich ! file handle - integer, intent(in) :: n3 - real(wp), intent(in) :: freq(n3) - real(wp), intent(in) :: ir_int(n3) - real(wp), intent(in), optional :: raman_activity(n3) - !> CAUTION: v_incident is in cm**(-1) - real(wp), intent(in), optional :: temp, v_incident - real(wp), allocatable :: raman_int(:) - integer :: i - real(wp) :: thr = 1.0e-2_wp - real(wp) :: thr_int = 1.0e-2_wp - real(wp) :: v_meter, hbycvb, bfactor, prefactor, v0minvito4, raman_act_si - - if (set%elprop == p_elprop_alpha) then - allocate (raman_int(n3), source=0.0_wp) - !> Conversion into measurable intensities follows - !> https://doi.org/10.1016/j.cplett.2004.12.096 - !> Chemical Physics Letters 403 (2005) 211–217 - !> Further literature under: http://chemcraftprog.com/help/spectrumwindow.html; - ! https://old.iupac.org/reports/V/spectro/partXVIII.pdf - ! https://doi.org/10.1016/j.molstruc.2004.06.004 - ! https://doi.org/10.1021/j100384a024 - do i = 1, n3 - !> B_i - v_meter = freq(i) * 1.0e2_wp - bfactor = 1.0_wp - exp(-(v_meter * h_SI * lightspeed_SI) / (kB_SI * temp)) - ! h - ! ------------- - ! c * vi * Bi - hbycvb = h_SI / (lightspeed_SI * v_meter * bfactor) - ! (2 * Pi)^4 - ! ------------------ - ! 45 * 8 * Pi^2 - prefactor = (2.0_wp * (pi**2)) / 45.0_wp - ! (v_incident - v_i)^4 - v0minvito4 = ((v_incident * 1.0e2_wp) - v_meter)**4 - !> Conversion into SI units - raman_act_si = raman_activity(i) / m4bykgtoang4byamu() - !> putting it all together - raman_int(i) = prefactor * hbycvb * v0minvito4 * raman_act_si * 1.0e+20_wp - end do - - write (ich, '("$vibrational spectrum")') - write(ich,'("# mode symmetry wave number IR intensity Raman activity Raman scatt. cross-section selection rules")') - write(ich,'("# (cm⁻¹) (km*mol⁻¹) (Å⁴*amu⁻¹) (Ų*sr⁻¹) IR RAMAN")') - do i = 1, n3 - if (abs(freq(i)) < thr) then - write (ich, '(i6,9x, f18.2,f16.5,f16.5,8x,e16.5,13x," - ",5x," - ")') & - & i, freq(i), 0.0_wp, 0.0_wp, 0.0_wp +end subroutine rdhess + +subroutine write_tm_vibspectrum(ich, n3, freq, ir_int, raman_activity, temp, v_incident) + use xtb_setparam + use xtb_mctc_constants + use xtb_mctc_convert + integer, intent(in) :: ich ! file handle + integer, intent(in) :: n3 + real(wp), intent(in) :: freq(n3) + real(wp), intent(in) :: ir_int(n3) + real(wp), intent(in), optional :: raman_activity(n3) + !> CAUTION: v_incident is in cm**(-1) + real(wp), intent(in), optional :: temp, v_incident + real(wp), allocatable :: raman_int(:) + integer :: i + real(wp) :: thr = 1.0e-2_wp + real(wp) :: thr_int = 1.0e-2_wp + real(wp) :: v_meter, hbycvb, bfactor, prefactor, v0minvito4, raman_act_si + + if (set%elprop == p_elprop_alpha) then + allocate (raman_int(n3), source=0.0_wp) + !> Conversion into measurable intensities follows + !> https://doi.org/10.1016/j.cplett.2004.12.096 + !> Chemical Physics Letters 403 (2005) 211–217 + !> Further literature under: http://chemcraftprog.com/help/spectrumwindow.html; + ! https://old.iupac.org/reports/V/spectro/partXVIII.pdf + ! https://doi.org/10.1016/j.molstruc.2004.06.004 + ! https://doi.org/10.1021/j100384a024 + do i = 1, n3 + !> B_i + v_meter = freq(i) * 1.0e2_wp + bfactor = 1.0_wp - exp(-(v_meter * h_SI * lightspeed_SI) / (kB_SI * temp)) + ! h + ! ------------- + ! c * vi * Bi + hbycvb = h_SI / (lightspeed_SI * v_meter * bfactor) + ! (2 * Pi)^4 + ! ------------------ + ! 45 * 8 * Pi^2 + prefactor = (2.0_wp * (pi**2)) / 45.0_wp + ! (v_incident - v_i)^4 + v0minvito4 = ((v_incident * 1.0e2_wp) - v_meter)**4 + !> Conversion into SI units + raman_act_si = raman_activity(i) / m4bykgtoang4byamu() + !> putting it all together + raman_int(i) = prefactor * hbycvb * v0minvito4 * raman_act_si * 1.0e+20_wp + end do + + write (ich, '("$vibrational spectrum")') + write(ich,'("# mode symmetry wave number IR intensity Raman activity Raman scatt. cross-section selection rules")') + write(ich,'("# (cm⁻¹) (km*mol⁻¹) (Å⁴*amu⁻¹) (Ų*sr⁻¹) IR RAMAN")') + do i = 1, n3 + if (abs(freq(i)) < thr) then + write (ich, '(i6,9x, f18.2,f16.5,f16.5,8x,e16.5,13x," - ",5x," - ")') & + & i, freq(i), 0.0_wp, 0.0_wp, 0.0_wp + else + write (ich, '(i6,8x,"a",f18.2,f16.5,f16.5,8x,e16.5,13x)', advance="no") & + & i, freq(i), ir_int(i), raman_activity(i), raman_int(i) + + if (ir_int(i) > thr_int) then + write (ich, '(a)', advance="no") "YES" else - write (ich, '(i6,8x,"a",f18.2,f16.5,f16.5,8x,e16.5,13x)', advance="no") & - & i, freq(i), ir_int(i), raman_activity(i), raman_int(i) - - if (ir_int(i) > thr_int) then - write (ich, '(a)', advance="no") "YES" - else - write (ich, '(a)', advance="no") "NO " - end if - - if (raman_activity(i) > thr_int) then - write (ich, '(5x,a)') "YES" - else - write (ich, '(5x,a)') "NO " - end if + write (ich, '(a)', advance="no") "NO " end if - end do - else - write (ich, '("$vibrational spectrum")') - write (ich, '("# mode symmetry wave number IR intensity selection rules")') - write (ich, '("# cm**(-1) (km*mol⁻¹) IR ")') - do i = 1, n3 - if (abs(freq(i)) < thr) then - write (ich, '(i6,9x, f18.2,f16.5,9x," - ")') & - i, freq(i), 0.0_wp + + if (raman_activity(i) > thr_int) then + write (ich, '(5x,a)') "YES" else - if (ir_int(i) > thr_int) then - write (ich, '(i6,8x,"a",f18.2,f16.5,9x,"YES")') & - i, freq(i), ir_int(i) - else - write (ich, '(i6,8x,"a",f18.2,f16.5,9x,"NO")') & - i, freq(i), ir_int(i) - end if + write (ich, '(5x,a)') "NO " end if - end do - end if - - write (ich, '("$end")') - end subroutine - - subroutine g98fake2(fname, n, at, xyz, freq, red_mass, ir_int, u2) - integer, intent(in) :: n - integer, intent(in) :: at(n) - real(wp), intent(in) :: freq(3 * n) - real(wp), intent(in) :: xyz(3, n) - real(wp), intent(in) :: u2(3 * n, 3 * n) - character(len=*), intent(in) :: fname - real(wp), intent(in) :: red_mass(3 * n) - real(wp), intent(in) :: ir_int(3 * n) - - integer :: gu, i, j, ka, kb, kc, la, lb, k - character(len=2) :: irrep - real(wp), allocatable :: u(:, :) - real(wp), allocatable :: red(:) - real(wp), allocatable :: f2(:) - real(wp), allocatable :: ir(:) - real(wp) :: zero - - allocate (u(3 * n, 3 * n), red(3 * n), f2(3 * n), ir(3 * n), source=0.0_wp) - - irrep = 'a' - zero = 0.0 - - k = 0 - do i = 1, 3 * n - if (abs(freq(i)) > 1.d-1) then - k = k + 1 - u(1:3 * n, k) = u2(1:3 * n, i) - f2(k) = freq(i) - ir(k) = ir_int(i) - red(k) = red_mass(i) end if end do - - gu = 55 - call open_file(gu, fname, 'w') - write (gu, '('' Entering Gaussian System'')') - write (gu, '('' *********************************************'')') - write (gu, '('' Gaussian 98:'')') - write (gu, '('' frequency output generated by the xtb code'')') - write (gu, '('' *********************************************'')') - - write (gu, *) ' Standard orientation:' - write (gu, *) '---------------------------------------------', & - & '-----------------------' - write (gu, *) ' Center Atomic Atomic', & - & ' Coordinates (Angstroms)' - write (gu, *) ' Number Number Type ', & - & ' X Y Z' - write (gu, *) '-----------------------', & - & '---------------------------------------------' - j = 0 - do i = 1, n - write (gu, 111) i, at(i), j, xyz(1:3, i) * 0.52917726 + else + write (ich, '("$vibrational spectrum")') + write (ich, '("# mode symmetry wave number IR intensity selection rules")') + write (ich, '("# cm**(-1) (km*mol⁻¹) IR ")') + do i = 1, n3 + if (abs(freq(i)) < thr) then + write (ich, '(i6,9x, f18.2,f16.5,9x," - ")') & + i, freq(i), 0.0_wp + else + if (ir_int(i) > thr_int) then + write (ich, '(i6,8x,"a",f18.2,f16.5,9x,"YES")') & + i, freq(i), ir_int(i) + else + write (ich, '(i6,8x,"a",f18.2,f16.5,9x,"NO")') & + i, freq(i), ir_int(i) + end if + end if end do - write (gu, *) '----------------------', & - & '----------------------------------------------' - write (gu, *) ' 1 basis functions 1 primitive gaussians' - write (gu, *) ' 1 alpha electrons 1 beta electrons' - write (gu, *) + end if + + write (ich, '("$end")') +end subroutine + +subroutine g98fake2(fname, n, at, xyz, freq, red_mass, ir_int, u2) + integer, intent(in) :: n + integer, intent(in) :: at(n) + real(wp), intent(in) :: freq(3 * n) + real(wp), intent(in) :: xyz(3, n) + real(wp), intent(in) :: u2(3 * n, 3 * n) + character(len=*), intent(in) :: fname + real(wp), intent(in) :: red_mass(3 * n) + real(wp), intent(in) :: ir_int(3 * n) + + integer :: gu, i, j, ka, kb, kc, la, lb, k + character(len=2) :: irrep + real(wp), allocatable :: u(:, :) + real(wp), allocatable :: red(:) + real(wp), allocatable :: f2(:) + real(wp), allocatable :: ir(:) + real(wp) :: zero + + allocate (u(3 * n, 3 * n), red(3 * n), f2(3 * n), ir(3 * n), source=0.0_wp) + + irrep = 'a' + zero = 0.0 + + k = 0 + do i = 1, 3 * n + if (abs(freq(i)) > 1.d-1) then + k = k + 1 + u(1:3 * n, k) = u2(1:3 * n, i) + f2(k) = freq(i) + ir(k) = ir_int(i) + red(k) = red_mass(i) + end if + end do + + gu = 55 + call open_file(gu, fname, 'w') + write (gu, '('' Entering Gaussian System'')') + write (gu, '('' *********************************************'')') + write (gu, '('' Gaussian 98:'')') + write (gu, '('' frequency output generated by the xtb code'')') + write (gu, '('' *********************************************'')') + + write (gu, *) ' Standard orientation:' + write (gu, *) '---------------------------------------------', & + & '-----------------------' + write (gu, *) ' Center Atomic Atomic', & + & ' Coordinates (Angstroms)' + write (gu, *) ' Number Number Type ', & + & ' X Y Z' + write (gu, *) '-----------------------', & + & '---------------------------------------------' + j = 0 + do i = 1, n + write (gu, 111) i, at(i), j, xyz(1:3, i) * 0.52917726 + end do + write (gu, *) '----------------------', & + & '----------------------------------------------' + write (gu, *) ' 1 basis functions 1 primitive gaussians' + write (gu, *) ' 1 alpha electrons 1 beta electrons' + write (gu, *) 111 format(i5, i11, i14, 4x, 3f12.6) - write (gu, *) 'Harmonic frequencies (cm**-1), IR intensities', & - & ' (km*mol⁻¹),' - write (gu, *) 'Raman scattering activities (A**4/amu),', & - & ' Raman depolarization ratios,' - write (gu, *) 'reduced masses (AMU), force constants (mDyne/A)', & - & ' and normal coordinates:' + write (gu, *) 'Harmonic frequencies (cm**-1), IR intensities', & + & ' (km*mol⁻¹),' + write (gu, *) 'Raman scattering activities (A**4/amu),', & + & ' Raman depolarization ratios,' + write (gu, *) 'reduced masses (AMU), force constants (mDyne/A)', & + & ' and normal coordinates:' - ka = 1 - kc = 3 + ka = 1 + kc = 3 60 kb = min0(kc, k) - write (gu, 100) (j, j=ka, kb) - write (gu, 105) (irrep, j=ka, kb) - write (gu, 110) ' Frequencies --', (f2(j), j=ka, kb) - write (gu, 110) ' Red. masses --', (red(j), j=ka, kb) - write (gu, 110) ' Frc consts --', (zero, j=ka, kb) - write (gu, 110) ' IR Inten --', (ir(j), j=ka, kb) - write (gu, 110) ' Raman Activ --', (zero, j=ka, kb) - write (gu, 110) ' Depolar --', (zero, j=ka, kb) - write (gu, *) 'Atom AN X Y Z X Y', & - & ' Z X Y Z' - la = 1 + write (gu, 100) (j, j=ka, kb) + write (gu, 105) (irrep, j=ka, kb) + write (gu, 110) ' Frequencies --', (f2(j), j=ka, kb) + write (gu, 110) ' Red. masses --', (red(j), j=ka, kb) + write (gu, 110) ' Frc consts --', (zero, j=ka, kb) + write (gu, 110) ' IR Inten --', (ir(j), j=ka, kb) + write (gu, 110) ' Raman Activ --', (zero, j=ka, kb) + write (gu, 110) ' Depolar --', (zero, j=ka, kb) + write (gu, *) 'Atom AN X Y Z X Y', & + & ' Z X Y Z' + la = 1 70 lb = n - do i = la, lb - write (gu, 130) i, at(i), (u(i * 3 - 2, j), u(i * 3 - 1, j), u(i * 3, j), j=ka, kb) - end do - if (lb == n) go to 90 - go to 70 + do i = la, lb + write (gu, 130) i, at(i), (u(i * 3 - 2, j), u(i * 3 - 1, j), u(i * 3, j), j=ka, kb) + end do + if (lb == n) go to 90 + go to 70 90 if (kb == k) then - return - end if - ka = kc + 1 - kc = kc + 3 - go to 60 + return + end if + ka = kc + 1 + kc = kc + 3 + go to 60 100 format(3(20x, i3)) 105 format(3x, 3(18x, a5)) 110 format(a15, f11.4, 12x, f11.4, 12x, f11.4) 130 format(2i4, 3(2x, 3f7.2)) - write (gu, '(''end of file'')') - call close_file(gu) - return + write (gu, '(''end of file'')') + call close_file(gu) + return - end subroutine g98fake2 +end subroutine g98fake2 !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc - subroutine g98fake(fname, n, at, xyz, freq, u2) - integer, intent(in) :: n - integer, intent(in) :: at(n) - real(wp), intent(in) :: freq(3 * n) - real(wp), intent(in) :: xyz(3, n) - real(wp), intent(in) :: u2(3 * n, 3 * n) - character(len=*), intent(in) :: fname - - integer :: gu, i, j, ka, kb, kc, la, lb, k - character(len=2) :: irrep - real(wp), allocatable :: u(:, :) - real(wp), allocatable :: red_mass(:) - real(wp), allocatable :: force(:) - real(wp), allocatable :: ir_int(:) - real(wp), allocatable :: f2(:) - real(wp) :: zero - - allocate (u(3 * n, 3 * n), red_mass(3 * n), force(3 * n), ir_int(3 * n), f2(3 * n), & - source=0.0_wp) - - irrep = 'a' - red_mass = 99.0 - force = 99.0 - ir_int = 99.0 - zero = 0.0 - - k = 0 - do i = 1, 3 * n - if (abs(freq(i)) > 1.d-1) then - k = k + 1 - u(1:3 * n, k) = u2(1:3 * n, i) - f2(k) = freq(i) - end if - end do - - gu = 55 - call open_file(gu, fname, 'w') - write (gu, '('' Entering Gaussian System'')') - write (gu, '('' *********************************************'')') - write (gu, '('' Gaussian 98:'')') - write (gu, '('' frequency output generated by the xtb code'')') - write (gu, '('' *********************************************'')') - - write (gu, *) ' Standard orientation:' - write (gu, *) '---------------------------------------------', & - & '-----------------------' - write (gu, *) ' Center Atomic Atomic', & - & ' Coordinates (Angstroms)' - write (gu, *) ' Number Number Type ', & - & ' X Y Z' - write (gu, *) '-----------------------', & - & '---------------------------------------------' - j = 0 - do i = 1, n - write (gu, 111) i, at(i), j, xyz(1:3, i) * 0.52917726 - end do - write (gu, *) '----------------------', & - & '----------------------------------------------' - write (gu, *) ' 1 basis functions 1 primitive gaussians' - write (gu, *) ' 1 alpha electrons 1 beta electrons' - write (gu, *) +subroutine g98fake(fname, n, at, xyz, freq, u2) + integer, intent(in) :: n + integer, intent(in) :: at(n) + real(wp), intent(in) :: freq(3 * n) + real(wp), intent(in) :: xyz(3, n) + real(wp), intent(in) :: u2(3 * n, 3 * n) + character(len=*), intent(in) :: fname + + integer :: gu, i, j, ka, kb, kc, la, lb, k + character(len=2) :: irrep + real(wp), allocatable :: u(:, :) + real(wp), allocatable :: red_mass(:) + real(wp), allocatable :: force(:) + real(wp), allocatable :: ir_int(:) + real(wp), allocatable :: f2(:) + real(wp) :: zero + + allocate (u(3 * n, 3 * n), red_mass(3 * n), force(3 * n), ir_int(3 * n), f2(3 * n), & + source=0.0_wp) + + irrep = 'a' + red_mass = 99.0 + force = 99.0 + ir_int = 99.0 + zero = 0.0 + + k = 0 + do i = 1, 3 * n + if (abs(freq(i)) > 1.d-1) then + k = k + 1 + u(1:3 * n, k) = u2(1:3 * n, i) + f2(k) = freq(i) + end if + end do + + gu = 55 + call open_file(gu, fname, 'w') + write (gu, '('' Entering Gaussian System'')') + write (gu, '('' *********************************************'')') + write (gu, '('' Gaussian 98:'')') + write (gu, '('' frequency output generated by the xtb code'')') + write (gu, '('' *********************************************'')') + + write (gu, *) ' Standard orientation:' + write (gu, *) '---------------------------------------------', & + & '-----------------------' + write (gu, *) ' Center Atomic Atomic', & + & ' Coordinates (Angstroms)' + write (gu, *) ' Number Number Type ', & + & ' X Y Z' + write (gu, *) '-----------------------', & + & '---------------------------------------------' + j = 0 + do i = 1, n + write (gu, 111) i, at(i), j, xyz(1:3, i) * 0.52917726 + end do + write (gu, *) '----------------------', & + & '----------------------------------------------' + write (gu, *) ' 1 basis functions 1 primitive gaussians' + write (gu, *) ' 1 alpha electrons 1 beta electrons' + write (gu, *) 111 format(i5, i11, i14, 4x, 3f12.6) - write (gu, *) 'Harmonic frequencies (cm**-1), IR intensities', ' (km*mol⁻¹),' - write (gu, *) 'Raman scattering activities (A**4/amu),', & - & ' Raman depolarization ratios,' - write (gu, *) 'reduced masses (AMU), force constants (mDyne/A)', & - & ' and normal coordinates:' + write (gu, *) 'Harmonic frequencies (cm**-1), IR intensities', ' (km*mol⁻¹),' + write (gu, *) 'Raman scattering activities (A**4/amu),', & + & ' Raman depolarization ratios,' + write (gu, *) 'reduced masses (AMU), force constants (mDyne/A)', & + & ' and normal coordinates:' - ka = 1 - kc = 3 + ka = 1 + kc = 3 60 kb = min0(kc, k) - write (gu, 100) (j, j=ka, kb) - write (gu, 105) (irrep, j=ka, kb) - write (gu, 110) ' Frequencies --', (f2(j), j=ka, kb) - write (gu, 110) ' Red. masses --', (red_mass(j), j=ka, kb) - write (gu, 110) ' Frc consts --', (force(j), j=ka, kb) - write (gu, 110) ' IR Inten --', (ir_int(j), j=ka, kb) - write (gu, 110) ' Raman Activ --', (zero, j=ka, kb) - write (gu, 110) ' Depolar --', (zero, j=ka, kb) - write (gu, *) 'Atom AN X Y Z X Y', & - & ' Z X Y Z' - la = 1 + write (gu, 100) (j, j=ka, kb) + write (gu, 105) (irrep, j=ka, kb) + write (gu, 110) ' Frequencies --', (f2(j), j=ka, kb) + write (gu, 110) ' Red. masses --', (red_mass(j), j=ka, kb) + write (gu, 110) ' Frc consts --', (force(j), j=ka, kb) + write (gu, 110) ' IR Inten --', (ir_int(j), j=ka, kb) + write (gu, 110) ' Raman Activ --', (zero, j=ka, kb) + write (gu, 110) ' Depolar --', (zero, j=ka, kb) + write (gu, *) 'Atom AN X Y Z X Y', & + & ' Z X Y Z' + la = 1 70 lb = n - do i = la, lb - write (gu, 130) i, at(i), (u(i * 3 - 2, j), u(i * 3 - 1, j), u(i * 3, j), j=ka, kb) - end do - if (lb == n) go to 90 - go to 70 + do i = la, lb + write (gu, 130) i, at(i), (u(i * 3 - 2, j), u(i * 3 - 1, j), u(i * 3, j), j=ka, kb) + end do + if (lb == n) go to 90 + go to 70 90 if (kb == k) then - return - end if - ka = kc + 1 - kc = kc + 3 - go to 60 + return + end if + ka = kc + 1 + kc = kc + 3 + go to 60 100 format(3(20x, i3)) 105 format(3x, 3(18x, a5)) 110 format(a15, f11.4, 12x, f11.4, 12x, f11.4) 130 format(2i4, 3(2x, 3f7.2)) - write (gu, '(''end of file'')') - call close_file(gu) - return + write (gu, '(''end of file'')') + call close_file(gu) + return - end subroutine g98fake +end subroutine g98fake end module xtb_freq_io diff --git a/src/main/json.F90 b/src/main/json.F90 index 2bc7deb58..072df7039 100644 --- a/src/main/json.F90 +++ b/src/main/json.F90 @@ -70,546 +70,546 @@ module xtb_main_json contains - subroutine main_xtb_json & - (ijson, mol, wfx, xbas, sccres, freqres) - use xtb_mctc_accuracy, only: wp +subroutine main_xtb_json & + (ijson, mol, wfx, xbas, sccres, freqres) + use xtb_mctc_accuracy, only: wp !! ======================================================================== ! load class definitions - use xtb_type_molecule - use xtb_type_wavefunction - use xtb_type_basisset - use xtb_type_data - use xtb_type_param + use xtb_type_molecule + use xtb_type_wavefunction + use xtb_type_basisset + use xtb_type_data + use xtb_type_param !! ======================================================================== ! global storage of options, parameters and basis set - use xtb_setparam + use xtb_setparam - implicit none + implicit none !! ======================================================================== - integer, intent(in) :: ijson ! file handle (usually json-file) + integer, intent(in) :: ijson ! file handle (usually json-file) ! molecule data - type(TMolecule), intent(in) :: mol - type(TWavefunction), intent(in) :: wfx - type(TBasisset), intent(in) :: xbas - type(scc_results), intent(in) :: sccres - type(freq_results), intent(in) :: freqres - logical :: alpha - alpha = set%elprop == p_elprop_alpha - - call write_json_header(ijson) - call write_json_scc_results(ijson, sccres) - if (freqres%gtot > 0.0_wp) then - call write_json_thermo(ijson, freqres) - end if - call write_json_charges(ijson, wfx) - if (set%gfn_method == 2) then - call write_json_dipole_moments(ijson, wfx) - call write_json_quadrupole_moments(ijson, wfx) - end if - call write_json_wavefunction(ijson, wfx) - if (freqres%n3true > 0) then - call write_json_frequencies(ijson, freqres) - call write_json_reduced_masses(ijson, freqres) - call write_json_intensities(ijson, freqres, alpha) - end if - call write_json_footer(ijson) - - end subroutine main_xtb_json - - subroutine write_json_header(ijson) - integer, intent(in) :: ijson - write (ijson, '("{")') - end subroutine write_json_header - - subroutine write_json_footer(ijson) - use xtb_setparam - include 'xtb_version.fh' - integer, intent(in) :: ijson - character(len=:), allocatable :: cmdline - integer :: l - call get_command(length=l) - allocate (character(len=l) :: cmdline) - call get_command(cmdline) - write (ijson, '(3x,''"program call":'',1x,''"'',a,''",'')') cmdline - write (ijson, '(3x,''"method": "GFN'',i0,''-xTB",'')') set%gfn_method - write (ijson, '(3x,a)') '"xtb version": "'//version//'"' - write (ijson, '("}")') - end subroutine write_json_footer - - subroutine write_json_ptb_footer(ijson) - use xtb_setparam - include 'xtb_version.fh' - integer, intent(in) :: ijson - character(len=:), allocatable :: cmdline - integer :: l - call get_command(length=l) - allocate (character(len=l) :: cmdline) - call get_command(cmdline) - write (ijson, '(3x,''"program call":'',1x,''"'',a,''",'')') cmdline - write (ijson, '(3x,''"method": "PTB",'')') - write (ijson, '(3x,a)') '"xtb version": "'//version//'"' - write (ijson, '("}")') - end subroutine write_json_ptb_footer - - subroutine write_json_scc_results(ijson, sccres) - use xtb_type_data - integer, intent(in) :: ijson - type(scc_results), intent(in) :: sccres - character(len=*), parameter :: jfmtf = '(3x,''"'',a,''":'',1x,f20.8,",")' - write (ijson, jfmtf) 'total energy', sccres%e_total - write (ijson, jfmtf) 'HOMO-LUMO gap / eV', sccres%hl_gap - write (ijson, jfmtf) 'electronic energy', sccres%e_elec - write (ijson, '(3x,''"'',a,''":'',1x,"[",2(f15.8,","),f15.8,"],")') & - 'dipole / a.u.', sccres%dipole - !write(ijson,jfmtf) 'classical repulsion energy',sccres%e_rep - !write(ijson,jfmtf) 'isotropic electrostatic energy',sccres%e_es - !write(ijson,jfmtf) 'anisotropic electrostatic energy',sccres%e_aes - !write(ijson,jfmtf) 'anisotropic XC energy',sccres%e_axc - !write(ijson,jfmtf) 'classical halogen bound energy',sccres%e_xb - !write(ijson,jfmtf) 'Generalized Born free energy',sccres%g_born - !write(ijson,jfmtf) 'SASA free energy',sccres%g_born - !write(ijson,jfmtf) 'Hydrogen bound free energy',sccres%g_born - end subroutine write_json_scc_results - - subroutine write_json_charges(ijson, wfn) - use xtb_type_wavefunction - integer, intent(in) :: ijson - type(TWavefunction), intent(in) :: wfn - character(len=*), parameter :: jfmta = '(3x,''"'',a,''": ['')' - character(len=*), parameter :: jfmtf = '(3x,''"'',a,''":'',1x,f20.8,",")' - integer :: i - write (ijson, jfmta) 'partial charges' - write (ijson, '(3x,f15.8,",")') (wfn%q(i), i=1, wfn%n - 1) - write (ijson, '(3x,f15.8,"],")') wfn%q(wfn%n) - end subroutine write_json_charges - - subroutine write_json_bondorder(ijson, mol, wfn) - use xtb_type_molecule, only: TMolecule - use xtb_type_wavefunction, only: TWavefunction - integer, intent(in) :: ijson - type(TMolecule), intent(in) :: mol - type(TWavefunction), intent(in) :: wfn - character(len=*), parameter :: jfmta = '(3x,''"'',a,''": ['')' - integer :: i, j - logical :: first - write (ijson, jfmta) 'bond orders' - do i = 1, mol%n - 1 - do j = i, mol%n - if (wfn%wbo(j, i) > 0.01) then - if (first) then - write (ijson, '(a)') ',' - end if - first = .true. - write (ijson, '(3x,"[ ",i5,",",i5,",",f8.4,"]")', advance='no') i, j, wfn%wbo(j, i) + type(TMolecule), intent(in) :: mol + type(TWavefunction), intent(in) :: wfx + type(TBasisset), intent(in) :: xbas + type(scc_results), intent(in) :: sccres + type(freq_results), intent(in) :: freqres + logical :: alpha + alpha = set%elprop == p_elprop_alpha + + call write_json_header(ijson) + call write_json_scc_results(ijson, sccres) + if (freqres%gtot > 0.0_wp) then + call write_json_thermo(ijson, freqres) + end if + call write_json_charges(ijson, wfx) + if (set%gfn_method == 2) then + call write_json_dipole_moments(ijson, wfx) + call write_json_quadrupole_moments(ijson, wfx) + end if + call write_json_wavefunction(ijson, wfx) + if (freqres%n3true > 0) then + call write_json_frequencies(ijson, freqres) + call write_json_reduced_masses(ijson, freqres) + call write_json_intensities(ijson, freqres, alpha) + end if + call write_json_footer(ijson) + +end subroutine main_xtb_json + +subroutine write_json_header(ijson) + integer, intent(in) :: ijson + write (ijson, '("{")') +end subroutine write_json_header + +subroutine write_json_footer(ijson) + use xtb_setparam + include 'xtb_version.fh' + integer, intent(in) :: ijson + character(len=:), allocatable :: cmdline + integer :: l + call get_command(length=l) + allocate (character(len=l) :: cmdline) + call get_command(cmdline) + write (ijson, '(3x,''"program call":'',1x,''"'',a,''",'')') cmdline + write (ijson, '(3x,''"method": "GFN'',i0,''-xTB",'')') set%gfn_method + write (ijson, '(3x,a)') '"xtb version": "'//version//'"' + write (ijson, '("}")') +end subroutine write_json_footer + +subroutine write_json_ptb_footer(ijson) + use xtb_setparam + include 'xtb_version.fh' + integer, intent(in) :: ijson + character(len=:), allocatable :: cmdline + integer :: l + call get_command(length=l) + allocate (character(len=l) :: cmdline) + call get_command(cmdline) + write (ijson, '(3x,''"program call":'',1x,''"'',a,''",'')') cmdline + write (ijson, '(3x,''"method": "PTB",'')') + write (ijson, '(3x,a)') '"xtb version": "'//version//'"' + write (ijson, '("}")') +end subroutine write_json_ptb_footer + +subroutine write_json_scc_results(ijson, sccres) + use xtb_type_data + integer, intent(in) :: ijson + type(scc_results), intent(in) :: sccres + character(len=*), parameter :: jfmtf = '(3x,''"'',a,''":'',1x,f20.8,",")' + write (ijson, jfmtf) 'total energy', sccres%e_total + write (ijson, jfmtf) 'HOMO-LUMO gap / eV', sccres%hl_gap + write (ijson, jfmtf) 'electronic energy', sccres%e_elec + write (ijson, '(3x,''"'',a,''":'',1x,"[",2(f15.8,","),f15.8,"],")') & + 'dipole / a.u.', sccres%dipole + !write(ijson,jfmtf) 'classical repulsion energy',sccres%e_rep + !write(ijson,jfmtf) 'isotropic electrostatic energy',sccres%e_es + !write(ijson,jfmtf) 'anisotropic electrostatic energy',sccres%e_aes + !write(ijson,jfmtf) 'anisotropic XC energy',sccres%e_axc + !write(ijson,jfmtf) 'classical halogen bound energy',sccres%e_xb + !write(ijson,jfmtf) 'Generalized Born free energy',sccres%g_born + !write(ijson,jfmtf) 'SASA free energy',sccres%g_born + !write(ijson,jfmtf) 'Hydrogen bound free energy',sccres%g_born +end subroutine write_json_scc_results + +subroutine write_json_charges(ijson, wfn) + use xtb_type_wavefunction + integer, intent(in) :: ijson + type(TWavefunction), intent(in) :: wfn + character(len=*), parameter :: jfmta = '(3x,''"'',a,''": ['')' + character(len=*), parameter :: jfmtf = '(3x,''"'',a,''":'',1x,f20.8,",")' + integer :: i + write (ijson, jfmta) 'partial charges' + write (ijson, '(3x,f15.8,",")') (wfn%q(i), i=1, wfn%n - 1) + write (ijson, '(3x,f15.8,"],")') wfn%q(wfn%n) +end subroutine write_json_charges + +subroutine write_json_bondorder(ijson, mol, wfn) + use xtb_type_molecule, only: TMolecule + use xtb_type_wavefunction, only: TWavefunction + integer, intent(in) :: ijson + type(TMolecule), intent(in) :: mol + type(TWavefunction), intent(in) :: wfn + character(len=*), parameter :: jfmta = '(3x,''"'',a,''": ['')' + integer :: i, j + logical :: first + write (ijson, jfmta) 'bond orders' + do i = 1, mol%n - 1 + do j = i, mol%n + if (wfn%wbo(j, i) > 0.01) then + if (first) then + write (ijson, '(a)') ',' end if - end do - end do - write (ijson, '(a,/)', advance='no') '],' - end subroutine write_json_bondorder - - subroutine write_json_dipole_moments(ijson, wfn) - use xtb_type_wavefunction - integer, intent(in) :: ijson - type(TWavefunction), intent(in) :: wfn - character(len=*), parameter :: jfmta = '(3x,''"'',a,''": ['')' - character(len=*), parameter :: jfmtf = '(3x,''"'',a,''":'',1x,f20.8,",")' - integer :: i, j - write (ijson, jfmta) 'atomic dipole moments' - do i = 1, wfn%n - 1 - write (ijson, '(3x,"[",2(f15.8,","),f15.8,"],")') (wfn%dipm(j, i), j=1, 3) - end do - write (ijson, '(3x,"[",2(f15.8,","),f15.8,"]],")') (wfn%dipm(j, wfn%n), j=1, 3) - end subroutine write_json_dipole_moments - - subroutine write_json_quadrupole_moments(ijson, wfn) - use xtb_type_wavefunction - integer, intent(in) :: ijson - type(TWavefunction), intent(in) :: wfn - character(len=*), parameter :: jfmta = '(3x,''"'',a,''": ['')' - character(len=*), parameter :: jfmtf = '(3x,''"'',a,''":'',1x,f20.8,",")' - integer :: i, j - write (ijson, jfmta) 'atomic quadrupole moments' - do i = 1, wfn%n - 1 - write (ijson, '(3x,"[",5(f15.8,","),f15.8,"],")') (wfn%qp(j, i), j=1, 6) + first = .true. + write (ijson, '(3x,"[ ",i5,",",i5,",",f8.4,"]")', advance='no') i, j, wfn%wbo(j, i) + end if end do - write (ijson, '(3x,"[",5(f15.8,","),f15.8,"]],")') (wfn%qp(j, wfn%n), j=1, 6) - end subroutine write_json_quadrupole_moments - - subroutine write_json_wavefunction(ijson, wfn) - use xtb_type_wavefunction - integer, intent(in) :: ijson - type(TWavefunction), intent(in) :: wfn - character(len=*), parameter :: jfmta = '(3x,''"'',a,''": ['')' - character(len=*), parameter :: jfmti = '(3x,''"'',a,''":'',1x,i0,",")' - character(len=*), parameter :: jfmtf = '(3x,''"'',a,''":'',1x,f20.8,",")' - integer :: i - write (ijson, jfmti) 'number of molecular orbitals', wfn%nao - write (ijson, jfmti) 'number of electrons', wfn%nel - write (ijson, jfmti) 'number of unpaired electrons', wfn%nopen - write (ijson, jfmta) 'orbital energies / eV' - write (ijson, '(3x,f15.8,",")') (wfn%emo(i), i=1, wfn%nao - 1) - write (ijson, '(3x,f15.8,"],")') wfn%emo(wfn%nao) - write (ijson, jfmta) 'fractional occupation' - write (ijson, '(3x,f15.8,",")') (wfn%focc(i), i=1, wfn%nao - 1) - write (ijson, '(3x,f15.8,"],")') wfn%focc(wfn%nao) - end subroutine write_json_wavefunction - - subroutine write_json_ptb_wavefunction(ijson, wfn) - use xtb_type_wavefunction - integer, intent(in) :: ijson - type(TWavefunction), intent(in) :: wfn - character(len=*), parameter :: jfmta = '(3x,''"'',a,''": ['')' - character(len=*), parameter :: jfmti = '(3x,''"'',a,''":'',1x,i0,",")' - character(len=*), parameter :: jfmtf = '(3x,''"'',a,''":'',1x,f20.8,",")' - integer :: i, max_print - max_print = min(wfn%nao, wfn%ihomo + 8) - write (ijson, jfmti) 'number of molecular orbitals', wfn%nao - write (ijson, jfmti) 'number of electrons', wfn%nel - write (ijson, jfmti) 'number of unpaired electrons', wfn%nopen - write (ijson, jfmta) 'orbital energies / eV' - write (ijson, '(3x,f15.8,",")') (wfn%emo(i), i=1, max_print - 1) - write (ijson, '(3x,f15.8,"],")') wfn%emo(max_print) - write (ijson, jfmta) 'fractional occupation' - write (ijson, '(3x,f15.8,",")') (wfn%focc(i), i=1, max_print - 1) - write (ijson, '(3x,f15.8,"],")') wfn%focc(max_print) - end subroutine write_json_ptb_wavefunction - - subroutine write_json_thermo(ijson, freqres) - use xtb_type_data - integer, intent(in) :: ijson - type(freq_results), intent(in) :: freqres - character(len=*), parameter :: jfmtf = '(3x,''"'',a,''":'',1x,f20.8,",")' - write (ijson, jfmtf) 'total enthalpy', freqres%htot - write (ijson, jfmtf) 'total free energy', freqres%gtot - end subroutine write_json_thermo - - subroutine write_json_frequencies(ijson, freqres) - use xtb_type_data - integer, intent(in) :: ijson - type(freq_results), intent(in) :: freqres - character(len=*), parameter :: jfmta = '(3x,''"'',a,''": ['')' - integer :: i - write (ijson, jfmta) 'vibrational frequencies / rcm' - write (ijson, '(3x,f15.8,",")') (freqres%freq(i), i=1, freqres%n3true - 1) - write (ijson, '(3x,f15.8,"],")') freqres%freq(freqres%n3true) - end subroutine write_json_frequencies - - subroutine write_json_intensities(ijson, freqres, printalpha) - use xtb_type_data - use xtb_mctc_accuracy, only: wp - integer, intent(in) :: ijson - type(freq_results), intent(in) :: freqres - logical, intent(in) :: printalpha - character(len=*), parameter :: jfmta = '(3x,''"'',a,''": ['')' - integer :: i - write (ijson, jfmta) 'IR intensities / km/mol' + end do + write (ijson, '(a,/)', advance='no') '],' +end subroutine write_json_bondorder + +subroutine write_json_dipole_moments(ijson, wfn) + use xtb_type_wavefunction + integer, intent(in) :: ijson + type(TWavefunction), intent(in) :: wfn + character(len=*), parameter :: jfmta = '(3x,''"'',a,''": ['')' + character(len=*), parameter :: jfmtf = '(3x,''"'',a,''":'',1x,f20.8,",")' + integer :: i, j + write (ijson, jfmta) 'atomic dipole moments' + do i = 1, wfn%n - 1 + write (ijson, '(3x,"[",2(f15.8,","),f15.8,"],")') (wfn%dipm(j, i), j=1, 3) + end do + write (ijson, '(3x,"[",2(f15.8,","),f15.8,"]],")') (wfn%dipm(j, wfn%n), j=1, 3) +end subroutine write_json_dipole_moments + +subroutine write_json_quadrupole_moments(ijson, wfn) + use xtb_type_wavefunction + integer, intent(in) :: ijson + type(TWavefunction), intent(in) :: wfn + character(len=*), parameter :: jfmta = '(3x,''"'',a,''": ['')' + character(len=*), parameter :: jfmtf = '(3x,''"'',a,''":'',1x,f20.8,",")' + integer :: i, j + write (ijson, jfmta) 'atomic quadrupole moments' + do i = 1, wfn%n - 1 + write (ijson, '(3x,"[",5(f15.8,","),f15.8,"],")') (wfn%qp(j, i), j=1, 6) + end do + write (ijson, '(3x,"[",5(f15.8,","),f15.8,"]],")') (wfn%qp(j, wfn%n), j=1, 6) +end subroutine write_json_quadrupole_moments + +subroutine write_json_wavefunction(ijson, wfn) + use xtb_type_wavefunction + integer, intent(in) :: ijson + type(TWavefunction), intent(in) :: wfn + character(len=*), parameter :: jfmta = '(3x,''"'',a,''": ['')' + character(len=*), parameter :: jfmti = '(3x,''"'',a,''":'',1x,i0,",")' + character(len=*), parameter :: jfmtf = '(3x,''"'',a,''":'',1x,f20.8,",")' + integer :: i + write (ijson, jfmti) 'number of molecular orbitals', wfn%nao + write (ijson, jfmti) 'number of electrons', wfn%nel + write (ijson, jfmti) 'number of unpaired electrons', wfn%nopen + write (ijson, jfmta) 'orbital energies / eV' + write (ijson, '(3x,f15.8,",")') (wfn%emo(i), i=1, wfn%nao - 1) + write (ijson, '(3x,f15.8,"],")') wfn%emo(wfn%nao) + write (ijson, jfmta) 'fractional occupation' + write (ijson, '(3x,f15.8,",")') (wfn%focc(i), i=1, wfn%nao - 1) + write (ijson, '(3x,f15.8,"],")') wfn%focc(wfn%nao) +end subroutine write_json_wavefunction + +subroutine write_json_ptb_wavefunction(ijson, wfn) + use xtb_type_wavefunction + integer, intent(in) :: ijson + type(TWavefunction), intent(in) :: wfn + character(len=*), parameter :: jfmta = '(3x,''"'',a,''": ['')' + character(len=*), parameter :: jfmti = '(3x,''"'',a,''":'',1x,i0,",")' + character(len=*), parameter :: jfmtf = '(3x,''"'',a,''":'',1x,f20.8,",")' + integer :: i, max_print + max_print = min(wfn%nao, wfn%ihomo + 8) + write (ijson, jfmti) 'number of molecular orbitals', wfn%nao + write (ijson, jfmti) 'number of electrons', wfn%nel + write (ijson, jfmti) 'number of unpaired electrons', wfn%nopen + write (ijson, jfmta) 'orbital energies / eV' + write (ijson, '(3x,f15.8,",")') (wfn%emo(i), i=1, max_print - 1) + write (ijson, '(3x,f15.8,"],")') wfn%emo(max_print) + write (ijson, jfmta) 'fractional occupation' + write (ijson, '(3x,f15.8,",")') (wfn%focc(i), i=1, max_print - 1) + write (ijson, '(3x,f15.8,"],")') wfn%focc(max_print) +end subroutine write_json_ptb_wavefunction + +subroutine write_json_thermo(ijson, freqres) + use xtb_type_data + integer, intent(in) :: ijson + type(freq_results), intent(in) :: freqres + character(len=*), parameter :: jfmtf = '(3x,''"'',a,''":'',1x,f20.8,",")' + write (ijson, jfmtf) 'total enthalpy', freqres%htot + write (ijson, jfmtf) 'total free energy', freqres%gtot +end subroutine write_json_thermo + +subroutine write_json_frequencies(ijson, freqres) + use xtb_type_data + integer, intent(in) :: ijson + type(freq_results), intent(in) :: freqres + character(len=*), parameter :: jfmta = '(3x,''"'',a,''": ['')' + integer :: i + write (ijson, jfmta) 'vibrational frequencies / rcm' + write (ijson, '(3x,f15.8,",")') (freqres%freq(i), i=1, freqres%n3true - 1) + write (ijson, '(3x,f15.8,"],")') freqres%freq(freqres%n3true) +end subroutine write_json_frequencies + +subroutine write_json_intensities(ijson, freqres, printalpha) + use xtb_type_data + use xtb_mctc_accuracy, only: wp + integer, intent(in) :: ijson + type(freq_results), intent(in) :: freqres + logical, intent(in) :: printalpha + character(len=*), parameter :: jfmta = '(3x,''"'',a,''": ['')' + integer :: i + write (ijson, jfmta) 'IR intensities / km/mol' + do i = 1, freqres%n3true - 1 + if (abs(freqres%freq(i)) < 1.0e-2_wp) then + write (ijson, '(3x,f15.8,",")') 0.0_wp + else + write (ijson, '(3x,f15.8,",")') freqres%dipt(i) + end if + end do + write (ijson, '(3x,f15.8,"],")') freqres%dipt(freqres%n3true) + if (printalpha) then + write (ijson, jfmta) 'Raman intensities / A^4/amu' do i = 1, freqres%n3true - 1 if (abs(freqres%freq(i)) < 1.0e-2_wp) then write (ijson, '(3x,f15.8,",")') 0.0_wp else - write (ijson, '(3x,f15.8,",")') freqres%dipt(i) + write (ijson, '(3x,f15.8,",")') freqres%polt(i) end if end do - write (ijson, '(3x,f15.8,"],")') freqres%dipt(freqres%n3true) - if (printalpha) then - write (ijson, jfmta) 'Raman intensities / A^4/amu' - do i = 1, freqres%n3true - 1 - if (abs(freqres%freq(i)) < 1.0e-2_wp) then - write (ijson, '(3x,f15.8,",")') 0.0_wp - else - write (ijson, '(3x,f15.8,",")') freqres%polt(i) - end if - end do - write (ijson, '(3x,f15.8,"],")') freqres%polt(freqres%n3true) - end if - end subroutine write_json_intensities - - subroutine write_json_reduced_masses(ijson, freqres) - use xtb_type_data - integer, intent(in) :: ijson - type(freq_results), intent(in) :: freqres - character(len=*), parameter :: jfmta = '(3x,''"'',a,''": ['')' - integer :: i - write (ijson, jfmta) 'reduced masses' - write (ijson, '(3x,f15.8,",")') (freqres%rmass(i), i=1, freqres%n3true - 1) - write (ijson, '(3x,f15.8,"],")') freqres%rmass(freqres%n3true) - end subroutine write_json_reduced_masses - - subroutine write_json_gfnff_lists(n, etot, gnorm, topo, nlist, printTopo) - use xtb_gfnff_topology, only: TGFFTopology - use xtb_gfnff_neighbourlist, only: TGFFNeighbourList - use xtb_gfnff_topology, only: TPrintTopo - use xtb_mctc_accuracy, only: wp - include 'xtb_version.fh' - !> gfnff topology lists - type(TGFFTopology), intent(in) :: topo - !> gfnff neighbourlist - type(TGFFNeighbourList), intent(in) :: nlist - !> topology printout booleans - type(TPrintTopo), intent(in) :: printTopo - !> total energy and gradient norm - real(wp), intent(in) :: etot, gnorm - character(len=:), allocatable :: cmdline - integer :: iunit, j, n, l - - call open_file(iunit, 'gfnff_lists.json', 'w') - ! header - write (iunit, '("{")') - ! lists printout - if (printTopo%etot) then ! total energy is scalar - write (iunit, '(3x,''"total energy":'',f25.15,",")') etot - end if - if (printTopo%gnorm) then ! gradient norm is scalar - write (iunit, '(3x,''"gradient norm":'',f25.15,",")') gnorm - end if - if (printTopo%nb) then ! nb(20,n) - write (iunit, '(3x,''"nb":'',"[")') - do j = 1, n - 1 - write (iunit, '(3x,"[",*(i7,:,","))', advance='no') topo%nb(:, j) - write (iunit, '("],")') - end do - write (iunit, '(3x,"[",*(i7,:,","),"]",/)', advance='no') topo%nb(:, n) - write (iunit, '("]")') - write (iunit, '(3x,"],")') - end if - if (printTopo%bpair) then ! bpair(n*(n+1)/2) packed symmetric matrix - write (iunit, '(3x,''"bpair":'',"[")') - write (iunit, '(3x,*(i7,:,","))', advance='no') topo%bpair - write (iunit, '(3x,"],")') - end if - if (printTopo%alist) then ! alist(3,nangl) - write (iunit, '(3x,''"alist":'',"[")') - do j = 1, topo%nangl - 1 - write (iunit, '(3x,"[",*(i8,:,","))', advance='no') topo%alist(:, j) - write (iunit, '("],")') - end do - write (iunit, '(3x,"[",*(i8,:,","),"]",/)', advance='no') topo%alist(:, topo%nangl) - write (iunit, '("]")') - write (iunit, '(3x,"],")') - end if - if (printTopo%blist) then ! blist(2,nbond) - write (iunit, '(3x,''"blist":'',"[")') - do j = 1, topo%nbond - 1 - write (iunit, '(3x,"[",*(i8,:,","))', advance='no') topo%blist(:, j) - write (iunit, '("],")') - end do - write (iunit, '(3x,"[",*(i8,:,","),"]",/)', advance='no') topo%blist(:, topo%nbond) - write (iunit, '("]")') - write (iunit, '(3x,"],")') - end if - if (printTopo%tlist) then ! tlist(5,ntors) - write (iunit, '(3x,''"tlist":'',"[")') - do j = 1, topo%ntors - 1 - write (iunit, '(3x,"[",*(i8,:,","))', advance='no') topo%tlist(:, j) - write (iunit, '("],")') - end do - write (iunit, '(3x,"[",*(i8,:,","),"]",/)', advance='no') topo%tlist(:, topo%ntors) - write (iunit, '("]")') - write (iunit, '(3x,"],")') - end if - if (printTopo%vtors) then ! vtors(2,ntors) - write (iunit, '(3x,''"vtors":'',"[")') - do j = 1, topo%ntors - 1 - write (iunit, '(3x,"[",*(f25.15,:,","))', advance='no') topo%vtors(:, j) - write (iunit, '("],")') - end do - write (iunit, '(3x,"[",*(f25.15,:,","),"]",/)', advance='no') topo%vtors(:, topo%ntors) - write (iunit, '("]")') - write (iunit, '(3x,"],")') - end if - if (printTopo%vbond) then ! vbond(3,nbond) - write (iunit, '(3x,''"vbond":'',"[")') - do j = 1, topo%nbond - 1 - write (iunit, '(3x,"[",*(f25.15,:,","))', advance='no') topo%vbond(:, j) + write (ijson, '(3x,f15.8,"],")') freqres%polt(freqres%n3true) + end if +end subroutine write_json_intensities + +subroutine write_json_reduced_masses(ijson, freqres) + use xtb_type_data + integer, intent(in) :: ijson + type(freq_results), intent(in) :: freqres + character(len=*), parameter :: jfmta = '(3x,''"'',a,''": ['')' + integer :: i + write (ijson, jfmta) 'reduced masses' + write (ijson, '(3x,f15.8,",")') (freqres%rmass(i), i=1, freqres%n3true - 1) + write (ijson, '(3x,f15.8,"],")') freqres%rmass(freqres%n3true) +end subroutine write_json_reduced_masses + +subroutine write_json_gfnff_lists(n, etot, gnorm, topo, nlist, printTopo) + use xtb_gfnff_topology, only: TGFFTopology + use xtb_gfnff_neighbourlist, only: TGFFNeighbourList + use xtb_gfnff_topology, only: TPrintTopo + use xtb_mctc_accuracy, only: wp + include 'xtb_version.fh' + !> gfnff topology lists + type(TGFFTopology), intent(in) :: topo + !> gfnff neighbourlist + type(TGFFNeighbourList), intent(in) :: nlist + !> topology printout booleans + type(TPrintTopo), intent(in) :: printTopo + !> total energy and gradient norm + real(wp), intent(in) :: etot, gnorm + character(len=:), allocatable :: cmdline + integer :: iunit, j, n, l + + call open_file(iunit, 'gfnff_lists.json', 'w') + ! header + write (iunit, '("{")') + ! lists printout + if (printTopo%etot) then ! total energy is scalar + write (iunit, '(3x,''"total energy":'',f25.15,",")') etot + end if + if (printTopo%gnorm) then ! gradient norm is scalar + write (iunit, '(3x,''"gradient norm":'',f25.15,",")') gnorm + end if + if (printTopo%nb) then ! nb(20,n) + write (iunit, '(3x,''"nb":'',"[")') + do j = 1, n - 1 + write (iunit, '(3x,"[",*(i7,:,","))', advance='no') topo%nb(:, j) + write (iunit, '("],")') + end do + write (iunit, '(3x,"[",*(i7,:,","),"]",/)', advance='no') topo%nb(:, n) + write (iunit, '("]")') + write (iunit, '(3x,"],")') + end if + if (printTopo%bpair) then ! bpair(n*(n+1)/2) packed symmetric matrix + write (iunit, '(3x,''"bpair":'',"[")') + write (iunit, '(3x,*(i7,:,","))', advance='no') topo%bpair + write (iunit, '(3x,"],")') + end if + if (printTopo%alist) then ! alist(3,nangl) + write (iunit, '(3x,''"alist":'',"[")') + do j = 1, topo%nangl - 1 + write (iunit, '(3x,"[",*(i8,:,","))', advance='no') topo%alist(:, j) + write (iunit, '("],")') + end do + write (iunit, '(3x,"[",*(i8,:,","),"]",/)', advance='no') topo%alist(:, topo%nangl) + write (iunit, '("]")') + write (iunit, '(3x,"],")') + end if + if (printTopo%blist) then ! blist(2,nbond) + write (iunit, '(3x,''"blist":'',"[")') + do j = 1, topo%nbond - 1 + write (iunit, '(3x,"[",*(i8,:,","))', advance='no') topo%blist(:, j) + write (iunit, '("],")') + end do + write (iunit, '(3x,"[",*(i8,:,","),"]",/)', advance='no') topo%blist(:, topo%nbond) + write (iunit, '("]")') + write (iunit, '(3x,"],")') + end if + if (printTopo%tlist) then ! tlist(5,ntors) + write (iunit, '(3x,''"tlist":'',"[")') + do j = 1, topo%ntors - 1 + write (iunit, '(3x,"[",*(i8,:,","))', advance='no') topo%tlist(:, j) + write (iunit, '("],")') + end do + write (iunit, '(3x,"[",*(i8,:,","),"]",/)', advance='no') topo%tlist(:, topo%ntors) + write (iunit, '("]")') + write (iunit, '(3x,"],")') + end if + if (printTopo%vtors) then ! vtors(2,ntors) + write (iunit, '(3x,''"vtors":'',"[")') + do j = 1, topo%ntors - 1 + write (iunit, '(3x,"[",*(f25.15,:,","))', advance='no') topo%vtors(:, j) + write (iunit, '("],")') + end do + write (iunit, '(3x,"[",*(f25.15,:,","),"]",/)', advance='no') topo%vtors(:, topo%ntors) + write (iunit, '("]")') + write (iunit, '(3x,"],")') + end if + if (printTopo%vbond) then ! vbond(3,nbond) + write (iunit, '(3x,''"vbond":'',"[")') + do j = 1, topo%nbond - 1 + write (iunit, '(3x,"[",*(f25.15,:,","))', advance='no') topo%vbond(:, j) + write (iunit, '("],")') + end do + write (iunit, '(3x,"[",*(f25.15,:,","),"]",/)', advance='no') topo%vbond(:, topo%nbond) + write (iunit, '("]")') + write (iunit, '(3x,"],")') + end if + if (printTopo%vangl) then ! vangl(2,nangl) + write (iunit, '(3x,''"vangl":'',"[")') + do j = 1, topo%nangl - 1 + write (iunit, '(3x,"[",*(f25.15,:,","))', advance='no') topo%vangl(:, j) + write (iunit, '("],")') + end do + write (iunit, '(3x,"[",*(f25.15,:,","),"]",/)', advance='no') topo%vangl(:, topo%nangl) + write (iunit, '("]")') + write (iunit, '(3x,"],")') + end if + if (printTopo%hbbond) then ! hbbond: 3x(3,nhb) energies: 3x(1,nhb) + write (iunit, '(3x,''"hbl":'',"[")') !> HBs loose + if (nlist%nhb1 >= 1) then + do j = 1, nlist%nhb1 - 1 + write (iunit, '(3x,"[",*(i7,:,","))', advance='no') nlist%hblist1(:, j) write (iunit, '("],")') end do - write (iunit, '(3x,"[",*(f25.15,:,","),"]",/)', advance='no') topo%vbond(:, topo%nbond) + write (iunit, '(3x,"[",*(i7,:,","),"]",/)', advance='no') nlist%hblist1(:, nlist%nhb1) write (iunit, '("]")') write (iunit, '(3x,"],")') - end if - if (printTopo%vangl) then ! vangl(2,nangl) - write (iunit, '(3x,''"vangl":'',"[")') - do j = 1, topo%nangl - 1 - write (iunit, '(3x,"[",*(f25.15,:,","))', advance='no') topo%vangl(:, j) - write (iunit, '("],")') - end do - write (iunit, '(3x,"[",*(f25.15,:,","),"]",/)', advance='no') topo%vangl(:, topo%nangl) + else + write (iunit, '(3x,"[",*(i7,:,""))', advance='no') 0 write (iunit, '("]")') write (iunit, '(3x,"],")') end if - if (printTopo%hbbond) then ! hbbond: 3x(3,nhb) energies: 3x(1,nhb) - write (iunit, '(3x,''"hbl":'',"[")') !> HBs loose - if (nlist%nhb1 >= 1) then - do j = 1, nlist%nhb1 - 1 - write (iunit, '(3x,"[",*(i7,:,","))', advance='no') nlist%hblist1(:, j) - write (iunit, '("],")') - end do - write (iunit, '(3x,"[",*(i7,:,","),"]",/)', advance='no') nlist%hblist1(:, nlist%nhb1) - write (iunit, '("]")') - write (iunit, '(3x,"],")') - else - write (iunit, '(3x,"[",*(i7,:,""))', advance='no') 0 - write (iunit, '("]")') - write (iunit, '(3x,"],")') - end if - - write (iunit, '(3x,''"hbb":'',"[")') !> HBs bonded - if (nlist%nhb2 >= 1) then - do j = 1, nlist%nhb2 - 1 - write (iunit, '(3x,"[",*(i7,:,","))', advance='no') nlist%hblist2(:, j) - write (iunit, '("],")') - end do - write (iunit, '(3x,"[",*(i7,:,","),"]",/)', advance='no') nlist%hblist2(:, nlist%nhb2) - write (iunit, '("]")') - write (iunit, '(3x,"],")') - else - write (iunit, '(3x,"[",*(i7,:,""))', advance='no') 0 - write (iunit, '("]")') - write (iunit, '(3x,"],")') - end if - write (iunit, '(3x,''"xb":'',"[")') !> XBs - if (nlist%nxb >= 1) then - do j = 1, nlist%nxb - 1 - write (iunit, '(3x,"[",*(i7,:,","))', advance='no') nlist%hblist3(:, j) - write (iunit, '("],")') - end do - write (iunit, '(3x,"[",*(i7,:,","),"]",/)', advance='no') nlist%hblist3(:, nlist%nxb) - write (iunit, '("]")') - write (iunit, '(3x,"],")') - else - write (iunit, '(3x,"[",*(i7,:,""))', advance='no') 0 - write (iunit, '("]")') - write (iunit, '(3x,"],")') - end if - - ! energies - write (iunit, '(3x,''"hbl_e":'',"[")') - do j = 1, nlist%nhb1 - 1 - write (iunit, '(3x,"[",*(f25.15,:,","))', advance='no') nlist%hbe1(j) + write (iunit, '(3x,''"hbb":'',"[")') !> HBs bonded + if (nlist%nhb2 >= 1) then + do j = 1, nlist%nhb2 - 1 + write (iunit, '(3x,"[",*(i7,:,","))', advance='no') nlist%hblist2(:, j) write (iunit, '("],")') end do - write (iunit, '(3x,"[",*(f25.15,:,","),"]",/)', advance='no') nlist%hbe1(nlist%nhb1) + write (iunit, '(3x,"[",*(i7,:,","),"]",/)', advance='no') nlist%hblist2(:, nlist%nhb2) write (iunit, '("]")') write (iunit, '(3x,"],")') - - write (iunit, '(3x,''"hbb_e":'',"[")') - do j = 1, nlist%nhb2 - 1 - write (iunit, '(3x,"[",*(f25.15,:,","))', advance='no') nlist%hbe2(j) - write (iunit, '("],")') - end do - write (iunit, '(3x,"[",*(f25.15,:,","),"]",/)', advance='no') nlist%hbe2(nlist%nhb2) + else + write (iunit, '(3x,"[",*(i7,:,""))', advance='no') 0 write (iunit, '("]")') write (iunit, '(3x,"],")') + end if - write (iunit, '(3x,''"xb_e":'',"[")') + write (iunit, '(3x,''"xb":'',"[")') !> XBs + if (nlist%nxb >= 1) then do j = 1, nlist%nxb - 1 - write (iunit, '(3x,"[",*(f25.15,:,","))', advance='no') nlist%hbe3(j) + write (iunit, '(3x,"[",*(i7,:,","))', advance='no') nlist%hblist3(:, j) write (iunit, '("],")') end do - write (iunit, '(3x,"[",*(f25.15,:,","),"]",/)', advance='no') nlist%hbe3(nlist%nxb) + write (iunit, '(3x,"[",*(i7,:,","),"]",/)', advance='no') nlist%hblist3(:, nlist%nxb) write (iunit, '("]")') write (iunit, '(3x,"],")') - end if - if (printTopo%eeq) then ! eeq(3,n) - write (iunit, '(3x,''"eeq":'',"[")') !> EEQ charges - do j = 1, size(nlist%q) - 1 - write (iunit, '(3x,"[",*(f25.15,:,","))', advance='no') nlist%q(j) - write (iunit, '("],")') - end do - write (iunit, '(3x,"[",*(f25.15,:,","),"]",/)', advance='no') nlist%q(size(nlist%q)) + else + write (iunit, '(3x,"[",*(i7,:,""))', advance='no') 0 write (iunit, '("]")') write (iunit, '(3x,"],")') end if - ! footer - call get_command(length=l) - allocate (character(len=l) :: cmdline) - call get_command(cmdline) - write (iunit, '(3x,''"program call":'',1x,''"'',a,''",'')') cmdline - write (iunit, '(3x,''"method": "GFN-FF"'',",")') - write (iunit, '(3x,a)') '"xtb version": "'//version//'"' - write (iunit, '("}")') - call close_file(iunit) - - end subroutine write_json_gfnff_lists + ! energies + write (iunit, '(3x,''"hbl_e":'',"[")') + do j = 1, nlist%nhb1 - 1 + write (iunit, '(3x,"[",*(f25.15,:,","))', advance='no') nlist%hbe1(j) + write (iunit, '("],")') + end do + write (iunit, '(3x,"[",*(f25.15,:,","),"]",/)', advance='no') nlist%hbe1(nlist%nhb1) + write (iunit, '("]")') + write (iunit, '(3x,"],")') + + write (iunit, '(3x,''"hbb_e":'',"[")') + do j = 1, nlist%nhb2 - 1 + write (iunit, '(3x,"[",*(f25.15,:,","))', advance='no') nlist%hbe2(j) + write (iunit, '("],")') + end do + write (iunit, '(3x,"[",*(f25.15,:,","),"]",/)', advance='no') nlist%hbe2(nlist%nhb2) + write (iunit, '("]")') + write (iunit, '(3x,"],")') + + write (iunit, '(3x,''"xb_e":'',"[")') + do j = 1, nlist%nxb - 1 + write (iunit, '(3x,"[",*(f25.15,:,","))', advance='no') nlist%hbe3(j) + write (iunit, '("],")') + end do + write (iunit, '(3x,"[",*(f25.15,:,","),"]",/)', advance='no') nlist%hbe3(nlist%nxb) + write (iunit, '("]")') + write (iunit, '(3x,"],")') + end if + if (printTopo%eeq) then ! eeq(3,n) + write (iunit, '(3x,''"eeq":'',"[")') !> EEQ charges + do j = 1, size(nlist%q) - 1 + write (iunit, '(3x,"[",*(f25.15,:,","))', advance='no') nlist%q(j) + write (iunit, '("],")') + end do + write (iunit, '(3x,"[",*(f25.15,:,","),"]",/)', advance='no') nlist%q(size(nlist%q)) + write (iunit, '("]")') + write (iunit, '(3x,"],")') + end if + + ! footer + call get_command(length=l) + allocate (character(len=l) :: cmdline) + call get_command(cmdline) + write (iunit, '(3x,''"program call":'',1x,''"'',a,''",'')') cmdline + write (iunit, '(3x,''"method": "GFN-FF"'',",")') + write (iunit, '(3x,a)') '"xtb version": "'//version//'"' + write (iunit, '("}")') + call close_file(iunit) + +end subroutine write_json_gfnff_lists #if WITH_TBLITE - subroutine main_ptb_json & - (ijson, mol, wfx, bas, sccres, freqres) - use mctc_env, only: wp - !! ======================================================================== - ! load class definitions - use xtb_type_molecule, only: TMolecule - use xtb_type_wavefunction, only: TWavefunction - use xtb_type_data, only: scc_results, freq_results - !> tblite-specific types - use tblite_basis_type, only: basis_type - !! ======================================================================== - ! global storage of options, parameters and basis set - use xtb_setparam - implicit none - - !! ======================================================================== - integer, intent(in) :: ijson ! file handle (usually json-file) - ! molecule data - type(TMolecule), intent(in) :: mol - type(TWavefunction), intent(in) :: wfx - type(basis_type), intent(in) :: bas - type(scc_results), intent(in) :: sccres - type(freq_results), intent(in) :: freqres - logical :: alpha - alpha = set%elprop == p_elprop_alpha - - call write_json_header(ijson) - call write_json_scc_results(ijson, sccres) - if (freqres%gtot > 0.0_wp) then - call write_json_thermo(ijson, freqres) - end if - call write_json_charges(ijson, wfx) - call write_json_ptb_shell_charges(ijson, mol, bas, wfx) - call write_json_bondorder(ijson, mol, wfx) - call write_json_dipole_moments(ijson, wfx) - call write_json_quadrupole_moments(ijson, wfx) - call write_json_ptb_wavefunction(ijson, wfx) - if (freqres%n3true > 0) then - call write_json_frequencies(ijson, freqres) - call write_json_reduced_masses(ijson, freqres) - call write_json_intensities(ijson, freqres, alpha) - end if - call write_json_ptb_footer(ijson) - - end subroutine main_ptb_json - - subroutine write_json_ptb_shell_charges(ijson, mol, bas, wfn) - use xtb_type_wavefunction, only: TWavefunction - use xtb_type_molecule, only: TMolecule - use xtb_ptb_vdzp, only: max_shell - use tblite_basis_type, only: basis_type - integer, intent(in) :: ijson - type(TMolecule), intent(in) :: mol - type(basis_type), intent(in) :: bas - type(TWavefunction), intent(in) :: wfn - character(len=*), parameter :: jfmta = '(3x,''"'',a,''": ['')' - character(len=*), parameter :: jfmtf = '(3x,''"'',a,''":'',1x,f20.8,",")' - integer :: iat, ish, ii - write (ijson, jfmta) 'shell charges' - do iat = 1, mol%n - ii = bas%ish_at(iat) - write (ijson, '(3x,a)', advance='no') "[" - do ish = 1, bas%nsh_at(iat) - 1 - write (ijson, '(f15.8,",")', advance="no") wfn%qsh(ii + ish) - end do - if (iat == mol%n) then - write (ijson, '(f15.8,"]],",/)', advance="no") wfn%qsh(ii + bas%nsh_at(iat)) - else - write (ijson, '(f15.8,"],",/)', advance="no") wfn%qsh(ii + bas%nsh_at(iat)) - end if +subroutine main_ptb_json & + (ijson, mol, wfx, bas, sccres, freqres) + use mctc_env, only: wp + !! ======================================================================== + ! load class definitions + use xtb_type_molecule, only: TMolecule + use xtb_type_wavefunction, only: TWavefunction + use xtb_type_data, only: scc_results, freq_results + !> tblite-specific types + use tblite_basis_type, only: basis_type + !! ======================================================================== + ! global storage of options, parameters and basis set + use xtb_setparam + implicit none + + !! ======================================================================== + integer, intent(in) :: ijson ! file handle (usually json-file) + ! molecule data + type(TMolecule), intent(in) :: mol + type(TWavefunction), intent(in) :: wfx + type(basis_type), intent(in) :: bas + type(scc_results), intent(in) :: sccres + type(freq_results), intent(in) :: freqres + logical :: alpha + alpha = set%elprop == p_elprop_alpha + + call write_json_header(ijson) + call write_json_scc_results(ijson, sccres) + if (freqres%gtot > 0.0_wp) then + call write_json_thermo(ijson, freqres) + end if + call write_json_charges(ijson, wfx) + call write_json_ptb_shell_charges(ijson, mol, bas, wfx) + call write_json_bondorder(ijson, mol, wfx) + call write_json_dipole_moments(ijson, wfx) + call write_json_quadrupole_moments(ijson, wfx) + call write_json_ptb_wavefunction(ijson, wfx) + if (freqres%n3true > 0) then + call write_json_frequencies(ijson, freqres) + call write_json_reduced_masses(ijson, freqres) + call write_json_intensities(ijson, freqres, alpha) + end if + call write_json_ptb_footer(ijson) + +end subroutine main_ptb_json + +subroutine write_json_ptb_shell_charges(ijson, mol, bas, wfn) + use xtb_type_wavefunction, only: TWavefunction + use xtb_type_molecule, only: TMolecule + use xtb_ptb_vdzp, only: max_shell + use tblite_basis_type, only: basis_type + integer, intent(in) :: ijson + type(TMolecule), intent(in) :: mol + type(basis_type), intent(in) :: bas + type(TWavefunction), intent(in) :: wfn + character(len=*), parameter :: jfmta = '(3x,''"'',a,''": ['')' + character(len=*), parameter :: jfmtf = '(3x,''"'',a,''":'',1x,f20.8,",")' + integer :: iat, ish, ii + write (ijson, jfmta) 'shell charges' + do iat = 1, mol%n + ii = bas%ish_at(iat) + write (ijson, '(3x,a)', advance='no') "[" + do ish = 1, bas%nsh_at(iat) - 1 + write (ijson, '(f15.8,",")', advance="no") wfn%qsh(ii + ish) end do - end subroutine write_json_ptb_shell_charges + if (iat == mol%n) then + write (ijson, '(f15.8,"]],",/)', advance="no") wfn%qsh(ii + bas%nsh_at(iat)) + else + write (ijson, '(f15.8,"],",/)', advance="no") wfn%qsh(ii + bas%nsh_at(iat)) + end if + end do +end subroutine write_json_ptb_shell_charges #endif end module xtb_main_json diff --git a/src/main/property.F90 b/src/main/property.F90 index 8a93f1cba..dbbf8aedc 100644 --- a/src/main/property.F90 +++ b/src/main/property.F90 @@ -30,1503 +30,1503 @@ module xtb_propertyoutput contains - subroutine write_energy(iunit, sccres, frqres, hess) - use xtb_type_data - implicit none - integer, intent(in) :: iunit ! file handle (usually output_unit=6) - logical, intent(in) :: hess - type(scc_results), intent(in) :: sccres - type(freq_results), intent(in) :: frqres - character(len=*), parameter :: outfmt = '(10x,"|",1x,a,f24.12,1x,a,1x,"|")' - write (iunit, '(a)') - write (iunit, '(11x,49("-"))') - if (hess) then - write (iunit, outfmt) "TOTAL ENERGY ", frqres%etot, "Eh " - write (iunit, outfmt) "TOTAL ENTHALPY ", frqres%etot + frqres%htot, "Eh " - write (iunit, outfmt) "TOTAL FREE ENERGY ", frqres%etot + frqres%gtot, "Eh " - write (iunit, outfmt) "GRADIENT NORM ", frqres%gnorm, "Eh/α" - else - write (iunit, outfmt) "TOTAL ENERGY ", sccres%e_total, "Eh " - write (iunit, outfmt) "GRADIENT NORM ", sccres%gnorm, "Eh/α" - end if - write (iunit, outfmt) "HOMO-LUMO GAP ", sccres%hl_gap, "eV " - write (iunit, '(11x,49("-"))') - end subroutine write_energy - - subroutine write_energy_gff(iunit, sccres, frqres, hess) - use xtb_type_data - implicit none - integer, intent(in) :: iunit ! file handle (usually output_unit=6) - logical, intent(in) :: hess - type(scc_results), intent(in) :: sccres - type(freq_results), intent(in) :: frqres - character(len=*), parameter :: outfmt = '(10x,"|",1x,a,f24.12,1x,a,1x,"|")' - write (iunit, '(a)') - write (iunit, '(11x,49("-"))') - if (hess) then - write (iunit, outfmt) "TOTAL ENERGY ", frqres%etot, "Eh " - write (iunit, outfmt) "TOTAL ENTHALPY ", frqres%etot + frqres%htot, "Eh " - write (iunit, outfmt) "TOTAL FREE ENERGY ", frqres%etot + frqres%gtot, "Eh " - write (iunit, outfmt) "GRADIENT NORM ", frqres%gnorm, "Eh/α" - else - write (iunit, outfmt) "TOTAL ENERGY ", sccres%e_total, "Eh " - write (iunit, outfmt) "GRADIENT NORM ", sccres%gnorm, "Eh/α" - end if - write (iunit, '(11x,49("-"))') - end subroutine write_energy_gff - -subroutine write_energy_oniom(iunit,sccres,frqres,hess) +subroutine write_energy(iunit, sccres, frqres, hess) use xtb_type_data implicit none integer, intent(in) :: iunit ! file handle (usually output_unit=6) logical, intent(in) :: hess type(scc_results), intent(in) :: sccres - type(freq_results),intent(in) :: frqres - character(len=*),parameter :: outfmt = '(10x,"|",1x,a,f18.12,1x,a,1x,"|")' + type(freq_results), intent(in) :: frqres + character(len=*), parameter :: outfmt = '(10x,"|",1x,a,f24.12,1x,a,1x,"|")' + write (iunit, '(a)') + write (iunit, '(11x,49("-"))') + if (hess) then + write (iunit, outfmt) "TOTAL ENERGY ", frqres%etot, "Eh " + write (iunit, outfmt) "TOTAL ENTHALPY ", frqres%etot + frqres%htot, "Eh " + write (iunit, outfmt) "TOTAL FREE ENERGY ", frqres%etot + frqres%gtot, "Eh " + write (iunit, outfmt) "GRADIENT NORM ", frqres%gnorm, "Eh/α" + else + write (iunit, outfmt) "TOTAL ENERGY ", sccres%e_total, "Eh " + write (iunit, outfmt) "GRADIENT NORM ", sccres%gnorm, "Eh/α" + end if + write (iunit, outfmt) "HOMO-LUMO GAP ", sccres%hl_gap, "eV " + write (iunit, '(11x,49("-"))') +end subroutine write_energy - write(iunit,'(a)') - write(iunit,'(11x,49("-"))') +subroutine write_energy_gff(iunit, sccres, frqres, hess) + use xtb_type_data + implicit none + integer, intent(in) :: iunit ! file handle (usually output_unit=6) + logical, intent(in) :: hess + type(scc_results), intent(in) :: sccres + type(freq_results), intent(in) :: frqres + character(len=*), parameter :: outfmt = '(10x,"|",1x,a,f24.12,1x,a,1x,"|")' + write (iunit, '(a)') + write (iunit, '(11x,49("-"))') if (hess) then - write(iunit,outfmt) "ONIOM TOTAL ENERGY ", frqres%etot, "Eh " - write(iunit,outfmt) "ONIOM TOTAL ENTHALPY ", frqres%etot+frqres%htot,"Eh " - write(iunit,outfmt) "ONIOM TOTAL FREE ENERGY ", frqres%etot+frqres%gtot,"Eh " - write(iunit,outfmt) "ONIOM GRADIENT NORM ", frqres%gnorm, "Eh/α" + write (iunit, outfmt) "TOTAL ENERGY ", frqres%etot, "Eh " + write (iunit, outfmt) "TOTAL ENTHALPY ", frqres%etot + frqres%htot, "Eh " + write (iunit, outfmt) "TOTAL FREE ENERGY ", frqres%etot + frqres%gtot, "Eh " + write (iunit, outfmt) "GRADIENT NORM ", frqres%gnorm, "Eh/α" else - write(iunit,outfmt) "ONIOM TOTAL ENERGY ", sccres%e_total,"Eh " - write(iunit,outfmt) "ONIOM GRADIENT NORM ", sccres%gnorm, "Eh/α" - endif - write(iunit,'(11x,49("-"))') + write (iunit, outfmt) "TOTAL ENERGY ", sccres%e_total, "Eh " + write (iunit, outfmt) "GRADIENT NORM ", sccres%gnorm, "Eh/α" + end if + write (iunit, '(11x,49("-"))') +end subroutine write_energy_gff + +subroutine write_energy_oniom(iunit,sccres,frqres,hess) +use xtb_type_data +implicit none +integer, intent(in) :: iunit ! file handle (usually output_unit=6) +logical, intent(in) :: hess +type(scc_results), intent(in) :: sccres +type(freq_results),intent(in) :: frqres +character(len=*),parameter :: outfmt = '(10x,"|",1x,a,f18.12,1x,a,1x,"|")' + +write(iunit,'(a)') +write(iunit,'(11x,49("-"))') +if (hess) then + write(iunit,outfmt) "ONIOM TOTAL ENERGY ", frqres%etot, "Eh " + write(iunit,outfmt) "ONIOM TOTAL ENTHALPY ", frqres%etot+frqres%htot,"Eh " + write(iunit,outfmt) "ONIOM TOTAL FREE ENERGY ", frqres%etot+frqres%gtot,"Eh " + write(iunit,outfmt) "ONIOM GRADIENT NORM ", frqres%gnorm, "Eh/α" +else + write(iunit,outfmt) "ONIOM TOTAL ENERGY ", sccres%e_total,"Eh " + write(iunit,outfmt) "ONIOM GRADIENT NORM ", sccres%gnorm, "Eh/α" +endif +write(iunit,'(11x,49("-"))') end subroutine write_energy_oniom - subroutine main_property & - (iunit, env, mol, wfx, basis, xtbData, res, solvModel, acc) +subroutine main_property & + (iunit, env, mol, wfx, basis, xtbData, res, solvModel, acc) - use xtb_mctc_convert + use xtb_mctc_convert !! ======================================================================== ! load class definitions - use xtb_type_molecule - use xtb_type_wavefunction - use xtb_type_environment - use xtb_type_basisset - use xtb_type_data - use xtb_type_param - use xtb_solv_model - use xtb_solv_gbsa, only: TBorn - use xtb_xtb_data - use xtb_intgrad + use xtb_type_molecule + use xtb_type_wavefunction + use xtb_type_environment + use xtb_type_basisset + use xtb_type_data + use xtb_type_param + use xtb_solv_model + use xtb_solv_gbsa, only: TBorn + use xtb_xtb_data + use xtb_intgrad !! ======================================================================== ! global storage of options, parameters and basis set - use xtb_setparam + use xtb_setparam !! ------------------------------------------------------------------------ - use xtb_aespot - use xtb_dtrafo + use xtb_aespot + use xtb_dtrafo - implicit none + implicit none !! ======================================================================== - integer, intent(in) :: iunit ! file handle (usually output_unit=6) + integer, intent(in) :: iunit ! file handle (usually output_unit=6) ! molecule data - type(TMolecule), intent(in) :: mol - type(TEnvironment), intent(inout) :: env - type(TxTBData), intent(in) :: xtbData - real(wp), intent(in) :: acc ! accuracy of integral calculation - type(TWavefunction), intent(inout) :: wfx - type(TBasisset), intent(in) :: basis - type(scc_results), intent(in) :: res - type(TSolvModel), allocatable, intent(in) :: solvModel - - real(wp), allocatable :: S(:, :) ! overlap integrals - real(wp), allocatable :: dpint(:, :, :) ! dipole integrals - real(wp), allocatable :: qpint(:, :, :) ! quadrupole integrals - real(wp), allocatable :: C(:, :) ! molecular orbitals - real(wp), allocatable :: emo(:) ! orbital energies - real(wp), allocatable :: focc(:) ! fractional occupation numbers - integer :: ifile - integer :: ndim, ndp, nqp - real(wp) :: dip, dipol(3) - real(wp) :: intcut, neglect - real(wp), parameter :: trans(3, 1) = 0.0_wp - - type(TBorn) :: gbsa + type(TMolecule), intent(in) :: mol + type(TEnvironment), intent(inout) :: env + type(TxTBData), intent(in) :: xtbData + real(wp), intent(in) :: acc ! accuracy of integral calculation + type(TWavefunction), intent(inout) :: wfx + type(TBasisset), intent(in) :: basis + type(scc_results), intent(in) :: res + type(TSolvModel), allocatable, intent(in) :: solvModel + + real(wp), allocatable :: S(:, :) ! overlap integrals + real(wp), allocatable :: dpint(:, :, :) ! dipole integrals + real(wp), allocatable :: qpint(:, :, :) ! quadrupole integrals + real(wp), allocatable :: C(:, :) ! molecular orbitals + real(wp), allocatable :: emo(:) ! orbital energies + real(wp), allocatable :: focc(:) ! fractional occupation numbers + integer :: ifile + integer :: ndim, ndp, nqp + real(wp) :: dip, dipol(3) + real(wp) :: intcut, neglect + real(wp), parameter :: trans(3, 1) = 0.0_wp + + type(TBorn) :: gbsa ! primitive cut-off - intcut = 25.0_wp - 10.0*log10(acc) - intcut = max(20.0_wp, intcut) + intcut = 25.0_wp - 10.0*log10(acc) + intcut = max(20.0_wp, intcut) ! integral neglect threshold - neglect = 10.0d-9*acc - ndim = basis%nao*(basis%nao + 1)/2 - allocate (S(basis%nao, basis%nao), dpint(3, basis%nao, basis%nao), & - & qpint(6, basis%nao, basis%nao), source=0.0_wp) + neglect = 10.0d-9*acc + ndim = basis%nao*(basis%nao + 1)/2 + allocate (S(basis%nao, basis%nao), dpint(3, basis%nao, basis%nao), & + & qpint(6, basis%nao, basis%nao), source=0.0_wp) #ifdef XTB_GPU - call sdqint_gpu(xtbData%nShell, xtbData%hamiltonian%angShell, mol%n, mol%at, & - & basis%nbf, basis%nao, mol%xyz, trans, intcut, & - & basis%caoshell, basis%saoshell, basis%nprim, basis%primcount, & - & basis%alp, basis%cont, S, dpint, qpint) + call sdqint_gpu(xtbData%nShell, xtbData%hamiltonian%angShell, mol%n, mol%at, & + & basis%nbf, basis%nao, mol%xyz, trans, intcut, & + & basis%caoshell, basis%saoshell, basis%nprim, basis%primcount, & + & basis%alp, basis%cont, S, dpint, qpint) #else - call sdqint(xtbData%nShell, xtbData%hamiltonian%angShell, mol%n, mol%at, & - & basis%nbf, basis%nao, mol%xyz, intcut, & - & basis%caoshell, basis%saoshell, basis%nprim, basis%primcount, & - & basis%alp, basis%cont, S, dpint, qpint) + call sdqint(xtbData%nShell, xtbData%hamiltonian%angShell, mol%n, mol%at, & + & basis%nbf, basis%nao, mol%xyz, intcut, & + & basis%caoshell, basis%saoshell, basis%nprim, basis%primcount, & + & basis%alp, basis%cont, S, dpint, qpint) #endif !! orbital energies and occupation - if (set%pr_eig) then - write (iunit, '(/,4x,"*",1x,a)') "Orbital Energies and Occupations" - call print_orbital_eigenvalues(iunit, wfx, 11) - end if + if (set%pr_eig) then + write (iunit, '(/,4x,"*",1x,a)') "Orbital Energies and Occupations" + call print_orbital_eigenvalues(iunit, wfx, 11) + end if !! Mulliken and CM5 charges - if (set%pr_mulliken .and. set%gfn_method .eq. 1) then - call print_mulliken(iunit, mol%n, mol%at, mol%sym, mol%xyz, mol%z, & - & basis%nao, S, wfx%P, basis%aoat2, basis%lao2) - end if - if (set%pr_charges) then - call open_file(ifile, 'charges', 'w') - call print_charges(ifile, mol%n, wfx%q) - call close_file(ifile) - end if + if (set%pr_mulliken .and. set%gfn_method .eq. 1) then + call print_mulliken(iunit, mol%n, mol%at, mol%sym, mol%xyz, mol%z, & + & basis%nao, S, wfx%P, basis%aoat2, basis%lao2) + end if + if (set%pr_charges) then + call open_file(ifile, 'charges', 'w') + call print_charges(ifile, mol%n, wfx%q) + call close_file(ifile) + end if - ! GBSA information - if (allocated(solvModel) .and. set%pr_gbsa) then - call newBornModel(solvModel, env, gbsa, mol%at) - call gbsa%update(env, mol%at, mol%xyz) - call print_gbsa_info(iunit, mol%sym, gbsa) - end if + ! GBSA information + if (allocated(solvModel) .and. set%pr_gbsa) then + call newBornModel(solvModel, env, gbsa, mol%at) + call gbsa%update(env, mol%at, mol%xyz) + call print_gbsa_info(iunit, mol%sym, gbsa) + end if !! D4 molecular dispersion printout - if ((set%newdisp .and. set%gfn_method .eq. 2) .and. set%pr_mulliken) then - call print_molpol(iunit, mol%n, mol%at, mol%sym, mol%xyz, wfx%q, & - & xtbData%dispersion%wf, xtbData%dispersion%g_a, xtbData%dispersion%g_c, & - & xtbData%dispersion%dispm) - end if - if (set%gfn_method .eq. 0 .and. set%pr_mulliken) then - call print_molpol(iunit, mol%n, mol%at, mol%sym, mol%xyz, wfx%q, & - & xtbData%dispersion%wf, xtbData%dispersion%g_a, xtbData%dispersion%g_c,& - & xtbData%dispersion%dispm) - end if + if ((set%newdisp .and. set%gfn_method .eq. 2) .and. set%pr_mulliken) then + call print_molpol(iunit, mol%n, mol%at, mol%sym, mol%xyz, wfx%q, & + & xtbData%dispersion%wf, xtbData%dispersion%g_a, xtbData%dispersion%g_c, & + & xtbData%dispersion%dispm) + end if + if (set%gfn_method .eq. 0 .and. set%pr_mulliken) then + call print_molpol(iunit, mol%n, mol%at, mol%sym, mol%xyz, wfx%q, & + & xtbData%dispersion%wf, xtbData%dispersion%g_a, xtbData%dispersion%g_c,& + & xtbData%dispersion%dispm) + end if !! Spin population - if (set%pr_spin_population .and. wfx%nopen .ne. 0) then - call print_spin_population(iunit, mol%n, mol%at, mol%sym, basis%nao, wfx%focca,& - & wfx%foccb, S, wfx%C, basis%aoat2, basis%lao2) - end if + if (set%pr_spin_population .and. wfx%nopen .ne. 0) then + call print_spin_population(iunit, mol%n, mol%at, mol%sym, basis%nao, wfx%focca,& + & wfx%foccb, S, wfx%C, basis%aoat2, basis%lao2) + end if - if (set%pr_fod_pop) then - call open_file(ifile, 'fod', 'w') - call print_fod_population(iunit, ifile, mol%n, mol%at, mol%sym, basis%nao, S, & - & wfx%C, set%etemp, wfx%emo, wfx%ihomoa, wfx%ihomob, basis%aoat2, basis%lao2) - call close_file(ifile) - end if + if (set%pr_fod_pop) then + call open_file(ifile, 'fod', 'w') + call print_fod_population(iunit, ifile, mol%n, mol%at, mol%sym, basis%nao, S, & + & wfx%C, set%etemp, wfx%emo, wfx%ihomoa, wfx%ihomob, basis%aoat2, basis%lao2) + call close_file(ifile) + end if !! wiberg bond orders - if (set%pr_wiberg) then - call open_file(ifile, 'wbo', 'w') - call print_wbofile(ifile, mol%n, wfx%wbo, 0.1_wp) - call close_file(ifile) - call print_wiberg(iunit, mol%n, mol%at, mol%sym, wfx%wbo, 0.1_wp) + if (set%pr_wiberg) then + call open_file(ifile, 'wbo', 'w') + call print_wbofile(ifile, mol%n, wfx%wbo, 0.1_wp) + call close_file(ifile) + call print_wiberg(iunit, mol%n, mol%at, mol%sym, wfx%wbo, 0.1_wp) - call checkTopology(iunit, mol, wfx%wbo, 1) - end if + call checkTopology(iunit, mol, wfx%wbo, 1) + end if - if (set%pr_wbofrag) & - call print_wbo_fragment(iunit, mol%n, mol%at, wfx%wbo, 0.1_wp) + if (set%pr_wbofrag) & + call print_wbo_fragment(iunit, mol%n, mol%at, wfx%wbo, 0.1_wp) !! molden file - if (set%pr_molden_input) then - allocate (C(basis%nbf, basis%nao), focc(basis%nao), emo(basis%nao), source=0.0_wp) - if (basis%nbf .eq. basis%nao) then - C = wfx%C - else - call sao2cao(basis%nao, wfx%C, basis%nbf, C, basis) - end if - emo = wfx%emo*evtoau - focc = wfx%focca + wfx%foccb - call printmold(mol%n, basis%nao, basis%nbf, mol%xyz, mol%at, C, emo, focc, 2.0_wp, basis) - write (iunit, '(/,"MOs/occ written to file ",/)') - deallocate (C, focc, emo) + if (set%pr_molden_input) then + allocate (C(basis%nbf, basis%nao), focc(basis%nao), emo(basis%nao), source=0.0_wp) + if (basis%nbf .eq. basis%nao) then + C = wfx%C + else + call sao2cao(basis%nao, wfx%C, basis%nbf, C, basis) end if + emo = wfx%emo*evtoau + focc = wfx%focca + wfx%foccb + call printmold(mol%n, basis%nao, basis%nbf, mol%xyz, mol%at, C, emo, focc, 2.0_wp, basis) + write (iunit, '(/,"MOs/occ written to file ",/)') + deallocate (C, focc, emo) + end if - if (set%pr_gbw) & - call wrgbw(xtbData, mol%n, mol%at, mol%xyz, mol%z, basis, wfx) + if (set%pr_gbw) & + call wrgbw(xtbData, mol%n, mol%at, mol%xyz, mol%z, basis, wfx) - if (set%pr_tmbas .or. set%pr_tmmos) then - call open_file(ifile, 'basis', 'w') - call write_tm_basis(ifile, xtbData, mol%n, mol%at, basis, wfx) - call close_file(ifile) - end if + if (set%pr_tmbas .or. set%pr_tmmos) then + call open_file(ifile, 'basis', 'w') + call write_tm_basis(ifile, xtbData, mol%n, mol%at, basis, wfx) + call close_file(ifile) + end if - if (set%pr_tmmos) then - call open_file(ifile, 'mos', 'w') - call write_tm_mos(ifile, mol%n, mol%at, basis, wfx) - call close_file(ifile) - end if + if (set%pr_tmmos) then + call open_file(ifile, 'mos', 'w') + call write_tm_mos(ifile, mol%n, mol%at, basis, wfx) + call close_file(ifile) + end if !! multipole moment prinout - if (set%pr_dipole) then - if (set%gfn_method .gt. 1) then - ! print overall multipole moment - call molmom(iunit, mol%n, mol%xyz, wfx%q, wfx%dipm, wfx%qp, dip, dipol) - write (iunit, '(a)') - else - call print_dipole(iunit, mol%n, mol%at, mol%xyz, mol%z, wfx%nao, wfx%P, dpint) - end if + if (set%pr_dipole) then + if (set%gfn_method .gt. 1) then + ! print overall multipole moment + call molmom(iunit, mol%n, mol%xyz, wfx%q, wfx%dipm, wfx%qp, dip, dipol) + write (iunit, '(a)') + else + call print_dipole(iunit, mol%n, mol%at, mol%xyz, mol%z, wfx%nao, wfx%P, dpint) end if + end if - end subroutine main_property +end subroutine main_property #if WITH_TBLITE - subroutine ptb_property & - (iunit, env, wfn, bas, struc, wfx, res) +subroutine ptb_property & + (iunit, env, wfn, bas, struc, wfx, res) - use xtb_mctc_convert - use xtb_type_molecule - use xtb_type_wavefunction - use xtb_type_environment - use xtb_type_basisset - use xtb_type_data + use xtb_mctc_convert + use xtb_type_molecule + use xtb_type_wavefunction + use xtb_type_environment + use xtb_type_basisset + use xtb_type_data - !======================================================================== - !> global storage of options, parameters and basis set - use xtb_setparam + !======================================================================== + !> global storage of options, parameters and basis set + use xtb_setparam - !======================================================================== - !> PTB specific property output - use xtb_ptb_property, only: print_charges_to_screen - use xtb_ptb_guess, only: get_psh_from_qsh + !======================================================================== + !> PTB specific property output + use xtb_ptb_property, only: print_charges_to_screen + use xtb_ptb_guess, only: get_psh_from_qsh - use mctc_io_structure, only : structure_type + use mctc_io_structure, only : structure_type - use tblite_basis_type, only: basis_type - use tblite_wavefunction_type, only: wavefunction_type + use tblite_basis_type, only: basis_type + use tblite_wavefunction_type, only: wavefunction_type - implicit none + implicit none - !======================================================================== - integer, intent(in) :: iunit ! file handle (usually output_unit=6) - !> tblite data formats - type(structure_type) :: mol - type(wavefunction_type), intent(in) :: wfn - type(basis_type), intent(in) :: bas - !> molecule data - type(TMolecule), intent(in) :: struc - type(TEnvironment), intent(inout) :: env - type(TWavefunction), intent(inout) :: wfx - type(scc_results), intent(in) :: res - integer :: ifile, i - real(wp), allocatable :: psh(:, :) - real(wp) :: dip, isotropic_alpha - - mol = struc - - !> orbital energies and occupation - if (set%pr_eig) then - write (iunit, '(/,4x,"*",1x,a)') "Orbital Energies and Occupations" - call print_orbital_eigenvalues(iunit, wfx, 11) - end if + !======================================================================== + integer, intent(in) :: iunit ! file handle (usually output_unit=6) + !> tblite data formats + type(structure_type) :: mol + type(wavefunction_type), intent(in) :: wfn + type(basis_type), intent(in) :: bas + !> molecule data + type(TMolecule), intent(in) :: struc + type(TEnvironment), intent(inout) :: env + type(TWavefunction), intent(inout) :: wfx + type(scc_results), intent(in) :: res + integer :: ifile, i + real(wp), allocatable :: psh(:, :) + real(wp) :: dip, isotropic_alpha + + mol = struc + + !> orbital energies and occupation + if (set%pr_eig) then + write (iunit, '(/,4x,"*",1x,a)') "Orbital Energies and Occupations" + call print_orbital_eigenvalues(iunit, wfx, 11) + end if - !> Mixed Mulliken-Loewdin atomic charges and shell populations - allocate (psh(bas%nsh, wfn%nspin), source=0.0_wp) - psh = get_psh_from_qsh(wfn, bas) - call print_charges_to_screen(iunit, mol, bas, wfn%qat, psh) - if (set%pr_charges) then - call open_file(ifile, 'charges', 'w') - call print_charges(ifile, struc%n, wfx%q) - call close_file(ifile) - end if + !> Mixed Mulliken-Loewdin atomic charges and shell populations + allocate (psh(bas%nsh, wfn%nspin), source=0.0_wp) + psh = get_psh_from_qsh(wfn, bas) + call print_charges_to_screen(iunit, mol, bas, wfn%qat, psh) + if (set%pr_charges) then + call open_file(ifile, 'charges', 'w') + call print_charges(ifile, struc%n, wfx%q) + call close_file(ifile) + end if - !> Spin population - ! if (set%pr_spin_population .and. wfx%nopen .ne. 0) then - ! call print_spin_population(iunit, mol%n, mol%at, mol%sym, basis%nao, wfx%focca,& - ! & wfx%foccb, S, wfx%C, basis%aoat2, basis%lao2) - ! end if + !> Spin population + ! if (set%pr_spin_population .and. wfx%nopen .ne. 0) then + ! call print_spin_population(iunit, mol%n, mol%at, mol%sym, basis%nao, wfx%focca,& + ! & wfx%foccb, S, wfx%C, basis%aoat2, basis%lao2) + ! end if !! wiberg bond orders - if (set%pr_wiberg) then - call open_file(ifile, 'wbo', 'w') - call print_wbofile(ifile, struc%n, wfx%wbo, 0.1_wp) - call close_file(ifile) - call print_wiberg(iunit, struc%n, struc%at, struc%sym, wfx%wbo, 0.1_wp) + if (set%pr_wiberg) then + call open_file(ifile, 'wbo', 'w') + call print_wbofile(ifile, struc%n, wfx%wbo, 0.1_wp) + call close_file(ifile) + call print_wiberg(iunit, struc%n, struc%at, struc%sym, wfx%wbo, 0.1_wp) - call checkTopology(iunit, struc, wfx%wbo, 1) - end if + call checkTopology(iunit, struc, wfx%wbo, 1) + end if - if (set%pr_wbofrag) & - call print_wbo_fragment(iunit, struc%n, struc%at, wfx%wbo, 0.1_wp) + if (set%pr_wbofrag) & + call print_wbo_fragment(iunit, struc%n, struc%at, wfx%wbo, 0.1_wp) - ! if (set%pr_tmmos) then - ! call open_file(ifile, 'mos', 'w') - ! call write_tm_mos(ifile, struc%n, struc%at, basis, wfx) - ! call close_file(ifile) - ! end if + ! if (set%pr_tmmos) then + ! call open_file(ifile, 'mos', 'w') + ! call write_tm_mos(ifile, struc%n, struc%at, basis, wfx) + ! call close_file(ifile) + ! end if - dip = norm2(res%dipole) + dip = norm2(res%dipole) + write (iunit, '(a)') + write (iunit, '(1x)', advance="no") + do i = 1,38 + write (iunit, '(a)', advance="no") "-" + end do + write (iunit, '(/)', advance="no") + write (iunit, '(4x,"Molecular dipole moment (a.u.)")') + write (iunit, '(4x,"X Y Z")') + write (iunit, '(1x)', advance="no") + do i = 1,38 + write (iunit, '(a)', advance="no") "-" + end do + write (iunit, '(/)', advance="no") + write (iunit, '(1x,3f9.4)') & + & res%dipole(1), res%dipole(2), res%dipole(3) + write (iunit, '(1x)', advance="no") + do i = 1,38 + write (iunit, '(a)', advance="no") "-" + end do + write (iunit, '(/)', advance="no") + write (iunit, '(4x,"Total dipole moment (a.u. / Debye):",/,1x,2f9.4)') & + & dip, dip*autod + + write (iunit, '(a)') + write (iunit, '(1x)', advance="no") + do i = 1,38 + write (iunit, '(a)', advance="no") "-" + end do + write (iunit, '(/)', advance="no") + write (iunit, '(4x,"Molecular quadrupole tensor: (a.u.)")') + write (iunit, '(9x,"X Y Z")') + write (iunit, '(4x,a,f10.4)') "X", res%quadrupole(1) + write (iunit, '(4x,a,2f10.4)') "Y", res%quadrupole(2:3) + write (iunit, '(4x,a,3f10.4)') "Z", res%quadrupole(4:6) + write (iunit, '(1x)', advance="no") + + if (set%elprop .eq. p_elprop_alpha) then + isotropic_alpha = ( res%alpha(1, 1) + res%alpha(2, 2) + res%alpha(3, 3) ) / 3.0_wp write (iunit, '(a)') write (iunit, '(1x)', advance="no") do i = 1,38 write (iunit, '(a)', advance="no") "-" end do write (iunit, '(/)', advance="no") - write (iunit, '(4x,"Molecular dipole moment (a.u.)")') - write (iunit, '(4x,"X Y Z")') - write (iunit, '(1x)', advance="no") - do i = 1,38 - write (iunit, '(a)', advance="no") "-" - end do - write (iunit, '(/)', advance="no") - write (iunit, '(1x,3f9.4)') & - & res%dipole(1), res%dipole(2), res%dipole(3) - write (iunit, '(1x)', advance="no") - do i = 1,38 - write (iunit, '(a)', advance="no") "-" - end do - write (iunit, '(/)', advance="no") - write (iunit, '(4x,"Total dipole moment (a.u. / Debye):",/,1x,2f9.4)') & - & dip, dip*autod - - write (iunit, '(a)') + write (iunit, '(4x,"Numerical polarizability tensor: (a.u.)")') + write (iunit, '(9x,"X Y Z")') + write (iunit, '(4x,a,3f10.4)') "X", res%alpha(1, 1:3) + write (iunit, '(4x,a,3f10.4)') "Y", res%alpha(2, 1:3) + write (iunit, '(4x,a,3f10.4)') "Z", res%alpha(3, 1:3) write (iunit, '(1x)', advance="no") do i = 1,38 write (iunit, '(a)', advance="no") "-" end do write (iunit, '(/)', advance="no") - write (iunit, '(4x,"Molecular quadrupole tensor: (a.u.)")') - write (iunit, '(9x,"X Y Z")') - write (iunit, '(4x,a,f10.4)') "X", res%quadrupole(1) - write (iunit, '(4x,a,2f10.4)') "Y", res%quadrupole(2:3) - write (iunit, '(4x,a,3f10.4)') "Z", res%quadrupole(4:6) - write (iunit, '(1x)', advance="no") - - if (set%elprop .eq. p_elprop_alpha) then - isotropic_alpha = ( res%alpha(1, 1) + res%alpha(2, 2) + res%alpha(3, 3) ) / 3.0_wp - write (iunit, '(a)') - write (iunit, '(1x)', advance="no") - do i = 1,38 - write (iunit, '(a)', advance="no") "-" - end do - write (iunit, '(/)', advance="no") - write (iunit, '(4x,"Numerical polarizability tensor: (a.u.)")') - write (iunit, '(9x,"X Y Z")') - write (iunit, '(4x,a,3f10.4)') "X", res%alpha(1, 1:3) - write (iunit, '(4x,a,3f10.4)') "Y", res%alpha(2, 1:3) - write (iunit, '(4x,a,3f10.4)') "Z", res%alpha(3, 1:3) - write (iunit, '(1x)', advance="no") - do i = 1,38 - write (iunit, '(a)', advance="no") "-" - end do - write (iunit, '(/)', advance="no") - write (iunit, '(4x,"Total isotropic dipole polarizability (a.u. / ų):",/,1x,2f9.4)') & - & isotropic_alpha, isotropic_alpha*(autoaa**3) - end if + write (iunit, '(4x,"Total isotropic dipole polarizability (a.u. / ų):",/,1x,2f9.4)') & + & isotropic_alpha, isotropic_alpha*(autoaa**3) + end if - end subroutine ptb_property +end subroutine ptb_property #endif - subroutine gfnff_property(iunit, n, xyz, topo, nlist) - use xtb_gfnff_topology, only: TGFFTopology - use xtb_gfnff_neighbourlist, only: TGFFNeighbourList - use xtb_aespot, only: molqdip - !! ======================================================================== - ! global storage of options, parameters and basis set - use xtb_setparam - integer, intent(in) :: iunit, n - real(wp), intent(in) :: xyz(3, n) - type(TGFFTopology), intent(in) :: topo - type(TGFFNeighbourList), intent(in) :: nlist - - ! dipole moment from charge - if (set%pr_dipole) then - call molqdip(iunit, n, xyz, nlist%q) - end if +subroutine gfnff_property(iunit, n, xyz, topo, nlist) + use xtb_gfnff_topology, only: TGFFTopology + use xtb_gfnff_neighbourlist, only: TGFFNeighbourList + use xtb_aespot, only: molqdip +!! ======================================================================== + ! global storage of options, parameters and basis set + use xtb_setparam + integer, intent(in) :: iunit, n + real(wp), intent(in) :: xyz(3, n) + type(TGFFTopology), intent(in) :: topo + type(TGFFNeighbourList), intent(in) :: nlist + + ! dipole moment from charge + if (set%pr_dipole) then + call molqdip(iunit, n, xyz, nlist%q) + end if - end subroutine gfnff_property +end subroutine gfnff_property - subroutine main_cube & - (lverbose, mol, wfx, basis, res) +subroutine main_cube & + (lverbose, mol, wfx, basis, res) - use xtb_mctc_convert + use xtb_mctc_convert !! ======================================================================== ! load class definitions - use xtb_type_molecule - use xtb_type_wavefunction - use xtb_type_basisset - use xtb_type_data - use xtb_type_param + use xtb_type_molecule + use xtb_type_wavefunction + use xtb_type_basisset + use xtb_type_data + use xtb_type_param !! ======================================================================== ! global storage of options, parameters and basis set - use xtb_setparam + use xtb_setparam !! ------------------------------------------------------------------------ - use xtb_aespot - use xtb_scc_core - use esp - use stm - use xtb_dtrafo + use xtb_aespot + use xtb_scc_core + use esp + use stm + use xtb_dtrafo - implicit none + implicit none !! ======================================================================== - logical, intent(in) :: lverbose + logical, intent(in) :: lverbose ! molecule data - type(TMolecule), intent(in) :: mol - type(TWavefunction), intent(in) :: wfx - type(TBasisset), intent(in) :: basis - type(scc_results), intent(in) :: res - - real(wp), allocatable :: C(:, :) ! molecular orbitals - real(wp), allocatable :: emo(:) ! orbital energies - real(wp), allocatable :: focc(:) ! fractional occupation numbers - real(wp), allocatable :: focca(:) ! fractional occupation numbers (alpha) - real(wp), allocatable :: foccb(:) ! fractional occupation numbers (beta) - integer :: ndim, ndp, nqp - real(wp) :: dip, dipol(3) - real(wp) :: acc, intcut, neglect - real(wp) :: efa, efb, ga, gb, nfoda, nfodb + type(TMolecule), intent(in) :: mol + type(TWavefunction), intent(in) :: wfx + type(TBasisset), intent(in) :: basis + type(scc_results), intent(in) :: res + + real(wp), allocatable :: C(:, :) ! molecular orbitals + real(wp), allocatable :: emo(:) ! orbital energies + real(wp), allocatable :: focc(:) ! fractional occupation numbers + real(wp), allocatable :: focca(:) ! fractional occupation numbers (alpha) + real(wp), allocatable :: foccb(:) ! fractional occupation numbers (beta) + integer :: ndim, ndp, nqp + real(wp) :: dip, dipol(3) + real(wp) :: acc, intcut, neglect + real(wp) :: efa, efb, ga, gb, nfoda, nfodb !! ------------------------------------------------------------------------ ! FOD - if (set%pr_fod) then - allocate (C(basis%nbf, basis%nao), focca(basis%nao), foccb(basis%nao), focc(basis%nao), emo(basis%nao), & - source=0.0_wp) - if (wfx%ihomoa + 1 .le. basis%nao) & - call fermismear(.false., basis%nao, wfx%ihomoa, set%etemp, wfx%emo, focca, nfoda, efa, ga) - if (wfx%ihomob + 1 .le. basis%nao) & - call fermismear(.false., basis%nao, wfx%ihomob, set%etemp, wfx%emo, foccb, nfodb, efb, gb) - emo = wfx%emo*evtoau - call fodenmak(.true., basis%nao, emo, focca, efa) - call fodenmak(.true., basis%nao, emo, foccb, efb) - focc = focca + foccb - if (basis%nbf .eq. basis%nao) then - C = wfx%C - else - call sao2cao(basis%nao, wfx%C, basis%nbf, C, basis) - end if - if (lverbose) & - write (stdout, '(/,"FOD written to file: ''fod.cub''",/)') - call cube(mol%n, basis%nao, basis%nbf, mol%xyz, mol%at, C, emo, focc, 'fod.cub', basis) - deallocate (C, focca, foccb, focc, emo) + if (set%pr_fod) then + allocate (C(basis%nbf, basis%nao), focca(basis%nao), foccb(basis%nao), focc(basis%nao), emo(basis%nao), & + source=0.0_wp) + if (wfx%ihomoa + 1 .le. basis%nao) & + call fermismear(.false., basis%nao, wfx%ihomoa, set%etemp, wfx%emo, focca, nfoda, efa, ga) + if (wfx%ihomob + 1 .le. basis%nao) & + call fermismear(.false., basis%nao, wfx%ihomob, set%etemp, wfx%emo, foccb, nfodb, efb, gb) + emo = wfx%emo*evtoau + call fodenmak(.true., basis%nao, emo, focca, efa) + call fodenmak(.true., basis%nao, emo, foccb, efb) + focc = focca + foccb + if (basis%nbf .eq. basis%nao) then + C = wfx%C + else + call sao2cao(basis%nao, wfx%C, basis%nbf, C, basis) end if + if (lverbose) & + write (stdout, '(/,"FOD written to file: ''fod.cub''",/)') + call cube(mol%n, basis%nao, basis%nbf, mol%xyz, mol%at, C, emo, focc, 'fod.cub', basis) + deallocate (C, focca, foccb, focc, emo) + end if !! ------------------------------------------------------------------------ ! print spin density to cube file - if (set%pr_spin_density .and. wfx%nopen .ne. 0) then - allocate (C(basis%nbf, basis%nao), focc(basis%nao), emo(basis%nao), source=0.0_wp) - if (basis%nbf .eq. basis%nao) then - C = wfx%C - else - call sao2cao(basis%nao, wfx%C, basis%nbf, C, basis) - end if - if (lverbose) & - write (stdout, '(/,"(R)spin-density written to file: ''spindensity.cub''",/)') - emo = wfx%emo*evtoau - focc = wfx%focca - wfx%foccb - call cube(mol%n, basis%nao, basis%nbf, mol%xyz, mol%at, C, emo, focc, 'spindensity.cub', basis) - deallocate (C, focc, emo) + if (set%pr_spin_density .and. wfx%nopen .ne. 0) then + allocate (C(basis%nbf, basis%nao), focc(basis%nao), emo(basis%nao), source=0.0_wp) + if (basis%nbf .eq. basis%nao) then + C = wfx%C + else + call sao2cao(basis%nao, wfx%C, basis%nbf, C, basis) end if + if (lverbose) & + write (stdout, '(/,"(R)spin-density written to file: ''spindensity.cub''",/)') + emo = wfx%emo*evtoau + focc = wfx%focca - wfx%foccb + call cube(mol%n, basis%nao, basis%nbf, mol%xyz, mol%at, C, emo, focc, 'spindensity.cub', basis) + deallocate (C, focc, emo) + end if !! ------------------------------------------------------------------------ ! print density to cube file - if (set%pr_density) then - allocate (C(basis%nbf, basis%nao), emo(basis%nao), source=0.0_wp) - if (basis%nbf .eq. basis%nao) then - C = wfx%C - else - call sao2cao(basis%nao, wfx%C, basis%nbf, C, basis) - end if - if (lverbose) & - write (stdout, '(/,"density written to file: ''density.cub''",/)') - emo = wfx%emo*evtoau - call cube(mol%n, basis%nao, basis%nbf, mol%xyz, mol%at, C, emo, wfx%focc, 'density.cub', basis) - deallocate (C, emo) + if (set%pr_density) then + allocate (C(basis%nbf, basis%nao), emo(basis%nao), source=0.0_wp) + if (basis%nbf .eq. basis%nao) then + C = wfx%C + else + call sao2cao(basis%nao, wfx%C, basis%nbf, C, basis) end if + if (lverbose) & + write (stdout, '(/,"density written to file: ''density.cub''",/)') + emo = wfx%emo*evtoau + call cube(mol%n, basis%nao, basis%nbf, mol%xyz, mol%at, C, emo, wfx%focc, 'density.cub', basis) + deallocate (C, emo) + end if !! ------------------------------------------------------------------------ ! make an ESP plot - if (set%pr_esp) then - allocate (C(basis%nbf, basis%nao), source=0.0_wp) - if (basis%nbf .eq. basis%nao) then - C = wfx%C - else - call sao2cao(basis%nao, wfx%C, basis%nbf, C, basis) - end if - call espplot(mol%n, basis%nao, basis%nbf, mol%at, mol%xyz, mol%z, wfx%focc, C, basis) - deallocate (C) + if (set%pr_esp) then + allocate (C(basis%nbf, basis%nao), source=0.0_wp) + if (basis%nbf .eq. basis%nao) then + C = wfx%C + else + call sao2cao(basis%nao, wfx%C, basis%nbf, C, basis) end if + call espplot(mol%n, basis%nao, basis%nbf, mol%at, mol%xyz, mol%z, wfx%focc, C, basis) + deallocate (C) + end if !! ------------------------------------------------------------------------ ! make a STM image - if (set%pr_stm) then - allocate (C(basis%nbf, basis%nao), focc(basis%nao), source=0.0_wp) - if (basis%nbf .eq. basis%nao) then - C = wfx%C - else - call sao2cao(basis%nao, wfx%C, basis%nbf, C, basis) - end if - if (wfx%ihomoa + 1 .le. wfx%nao) & - call fermismear(.false., basis%nao, wfx%ihomoa, set%etemp, wfx%emo, focc, nfoda, efa, ga) - if (wfx%ihomob + 1 .le. wfx%nao) & - call fermismear(.false., basis%nao, wfx%ihomob, set%etemp, wfx%emo, focc, nfodb, efb, gb) - call stmpic(mol%n, basis%nao, basis%nbf, mol%at, mol%xyz, C, 0.5_wp*(efa + efb), wfx%emo, basis) - deallocate (C, focc) + if (set%pr_stm) then + allocate (C(basis%nbf, basis%nao), focc(basis%nao), source=0.0_wp) + if (basis%nbf .eq. basis%nao) then + C = wfx%C + else + call sao2cao(basis%nao, wfx%C, basis%nbf, C, basis) end if + if (wfx%ihomoa + 1 .le. wfx%nao) & + call fermismear(.false., basis%nao, wfx%ihomoa, set%etemp, wfx%emo, focc, nfoda, efa, ga) + if (wfx%ihomob + 1 .le. wfx%nao) & + call fermismear(.false., basis%nao, wfx%ihomob, set%etemp, wfx%emo, focc, nfodb, efb, gb) + call stmpic(mol%n, basis%nao, basis%nbf, mol%at, mol%xyz, C, 0.5_wp*(efa + efb), wfx%emo, basis) + deallocate (C, focc) + end if - end subroutine main_cube +end subroutine main_cube - subroutine main_freq & - (iunit, mol, wfx, res) +subroutine main_freq & + (iunit, mol, wfx, res) - use xtb_mctc_convert + use xtb_mctc_convert !! ======================================================================== ! load class definitions - use xtb_type_molecule - use xtb_type_wavefunction - use xtb_type_basisset - use xtb_type_data - use xtb_type_param + use xtb_type_molecule + use xtb_type_wavefunction + use xtb_type_basisset + use xtb_type_data + use xtb_type_param !! ======================================================================== ! global storage of options, parameters and basis set - use xtb_setparam - use xtb_splitparam, only: atmass + use xtb_setparam + use xtb_splitparam, only: atmass !! ------------------------------------------------------------------------ - use xtb_hessian - use xtb_disp_ncoord - use xtb_io_writer_turbomole, only: writeNormalModesTurbomole + use xtb_hessian + use xtb_disp_ncoord + use xtb_io_writer_turbomole, only: writeNormalModesTurbomole - implicit none + implicit none !! ======================================================================== - integer, intent(in) :: iunit + integer, intent(in) :: iunit ! molecule data - type(TMolecule), intent(inout) :: mol - type(TWavefunction), intent(in) :: wfx - type(freq_results), intent(inout) :: res - - integer :: ifile - integer :: i, ii, j, jj, k, l - character(len=:), allocatable :: hname - real(wp), allocatable :: bond(:, :) - integer, allocatable :: molvec(:) - real(wp), allocatable :: cn(:) - real(wp), allocatable :: xyz0(:, :) - real(wp), allocatable :: h(:, :) - real(wp) :: etot, h298, dum - integer :: lowmode - - allocate (molvec(mol%n), source=0) - allocate (xyz0(3, mol%n), h(3*mol%n, 3*mol%n), bond(mol%n, mol%n), cn(mol%n), source=0.0_wp) - - if (res%linear) then - write (iunit, '(1x,a)') 'vibrational frequencies (cm⁻¹)' - else - write (iunit, '(1x,a)') 'projected vibrational frequencies (cm⁻¹)' - end if - call PREIGF(iunit, res%freq, res%n3true) - - write (iunit, '(1x,a)') 'reduced masses (amu)' - write (iunit, '(8(i4,'':'',f6.2))') (i, res%rmass(i), i=1, res%n3) - write (iunit, '(1x,a)') 'IR intensities (km·mol⁻¹)' - write (iunit, '(8(i4,'':'',f6.2))') (i, res%dipt(i), i=1, res%n3) - write (iunit, '(1x,a)') 'Raman intensities (Ä⁴*amu⁻¹)' - write (iunit, '(8(i4,'':'',f6.2))') (i, res%polt(i), i=1, res%n3) - - call open_file(ifile, 'vibspectrum', 'w') - if (set%elprop == p_elprop_alpha) then - call write_tm_vibspectrum(ifile, res%n3, res%freq, res%dipt, res%polt, 298.15_wp, 19435.0_wp) - else - call write_tm_vibspectrum(ifile, res%n3, res%freq, res%dipt, res%polt) - end if - call close_file(ifile) + type(TMolecule), intent(inout) :: mol + type(TWavefunction), intent(in) :: wfx + type(freq_results), intent(inout) :: res + + integer :: ifile + integer :: i, ii, j, jj, k, l + character(len=:), allocatable :: hname + real(wp), allocatable :: bond(:, :) + integer, allocatable :: molvec(:) + real(wp), allocatable :: cn(:) + real(wp), allocatable :: xyz0(:, :) + real(wp), allocatable :: h(:, :) + real(wp) :: etot, h298, dum + integer :: lowmode + + allocate (molvec(mol%n), source=0) + allocate (xyz0(3, mol%n), h(3*mol%n, 3*mol%n), bond(mol%n, mol%n), cn(mol%n), source=0.0_wp) + + if (res%linear) then + write (iunit, '(1x,a)') 'vibrational frequencies (cm⁻¹)' + else + write (iunit, '(1x,a)') 'projected vibrational frequencies (cm⁻¹)' + end if + call PREIGF(iunit, res%freq, res%n3true) + + write (iunit, '(1x,a)') 'reduced masses (amu)' + write (iunit, '(8(i4,'':'',f6.2))') (i, res%rmass(i), i=1, res%n3) + write (iunit, '(1x,a)') 'IR intensities (km·mol⁻¹)' + write (iunit, '(8(i4,'':'',f6.2))') (i, res%dipt(i), i=1, res%n3) + write (iunit, '(1x,a)') 'Raman intensities (Ä⁴*amu⁻¹)' + write (iunit, '(8(i4,'':'',f6.2))') (i, res%polt(i), i=1, res%n3) + + call open_file(ifile, 'vibspectrum', 'w') + if (set%elprop == p_elprop_alpha) then + call write_tm_vibspectrum(ifile, res%n3, res%freq, res%dipt, res%polt, 298.15_wp, 19435.0_wp) + else + call write_tm_vibspectrum(ifile, res%n3, res%freq, res%dipt, res%polt) + end if + call close_file(ifile) - write (iunit, '(1x,a)') 'output can be read by thermo (or use thermo option).' - write (iunit, '(1x,a)') 'writing molden fake output.' - write (iunit, '(1x,a)') & - & 'recommended (thermochemical) frequency scaling factor: 1.0' - call g98fake2('g98.out', mol%n, mol%at, mol%xyz, res%freq, res%rmass, res%dipt, res%hess) - - if (set%pr_nmtm) then - call open_file(ifile, "vib_normal_modes", 'w') - if (ifile .ne. -1) then - call writeNormalModesTurbomole(ifile, atmass, res%hess) - call close_file(ifile) - end if - end if + write (iunit, '(1x,a)') 'output can be read by thermo (or use thermo option).' + write (iunit, '(1x,a)') 'writing molden fake output.' + write (iunit, '(1x,a)') & + & 'recommended (thermochemical) frequency scaling factor: 1.0' + call g98fake2('g98.out', mol%n, mol%at, mol%xyz, res%freq, res%rmass, res%dipt, res%hess) - call generic_header(iunit, "Thermodynamic Functions", 49, 10) - call print_thermo(iunit, mol%n, res%n3true, mol%at, mol%xyz, res%freq, res%etot, res%htot, res%gtot, & - res%nimag, .true., res%zp) - res%pg = trim(set%pgroup) - res%temp = set%thermotemp(set%nthermo) - if (set%enso_mode) then - call open_file(ifile, "xtb_enso.json", 'w') - if (ifile .ne. -1) then - call enso_printout(ifile, res) - call close_file(ifile) - end if + if (set%pr_nmtm) then + call open_file(ifile, "vib_normal_modes", 'w') + if (ifile .ne. -1) then + call writeNormalModesTurbomole(ifile, atmass, res%hess) + call close_file(ifile) end if + end if - ! distort along imags if present - call distort(mol, res%freq, res%hess) - - if (set%pr_modef .and. (mol%n .gt. 3)) then - - ! do analysis and write mode following file - call wrmodef(0, mol%n, mol%at, mol%xyz, wfx%wbo, res%rmass, res%freq, res%hess, h, set%mode_vthr, res%linear) - - ! localize the modes - if (set%mode_vthr .gt. 1.d-6) then - ! determine molecular fragments - call ncoord_erf(mol%n, mol%at, mol%xyz, cn) - call cutcov(mol%n, mol%at, mol%xyz, cn, wfx%wbo, bond) - call mrec(i, mol%xyz, cn, bond, mol%n, mol%at, molvec) - call locmode(mol%n, res%n3, mol%at, mol%xyz, set%mode_vthr, res%freq, res%rmass, res%hess, & - i, molvec) - call PREIGF0(iunit, res%freq, res%n3true) - write (iunit, '("written to xtb_localmodes and g98l.out")') - call wrmodef(1, mol%n, mol%at, mol%xyz, wfx%wbo, res%rmass, res%freq, res%hess, & - h, set%mode_vthr + 200.0_wp, res%linear) - end if - - call open_file(ifile, '.tmpxtbmodef', 'w') - write (ifile, *) res%lowmode, res%lowmode - write (ifile, *) res%etot ! energy for comparison + call generic_header(iunit, "Thermodynamic Functions", 49, 10) + call print_thermo(iunit, mol%n, res%n3true, mol%at, mol%xyz, res%freq, res%etot, res%htot, res%gtot, & + res%nimag, .true., res%zp) + res%pg = trim(set%pgroup) + res%temp = set%thermotemp(set%nthermo) + if (set%enso_mode) then + call open_file(ifile, "xtb_enso.json", 'w') + if (ifile .ne. -1) then + call enso_printout(ifile, res) call close_file(ifile) + end if + end if + ! distort along imags if present + call distort(mol, res%freq, res%hess) + + if (set%pr_modef .and. (mol%n .gt. 3)) then + + ! do analysis and write mode following file + call wrmodef(0, mol%n, mol%at, mol%xyz, wfx%wbo, res%rmass, res%freq, res%hess, h, set%mode_vthr, res%linear) + + ! localize the modes + if (set%mode_vthr .gt. 1.d-6) then + ! determine molecular fragments + call ncoord_erf(mol%n, mol%at, mol%xyz, cn) + call cutcov(mol%n, mol%at, mol%xyz, cn, wfx%wbo, bond) + call mrec(i, mol%xyz, cn, bond, mol%n, mol%at, molvec) + call locmode(mol%n, res%n3, mol%at, mol%xyz, set%mode_vthr, res%freq, res%rmass, res%hess, & + i, molvec) + call PREIGF0(iunit, res%freq, res%n3true) + write (iunit, '("written to xtb_localmodes and g98l.out")') + call wrmodef(1, mol%n, mol%at, mol%xyz, wfx%wbo, res%rmass, res%freq, res%hess, & + h, set%mode_vthr + 200.0_wp, res%linear) end if - end subroutine main_freq + call open_file(ifile, '.tmpxtbmodef', 'w') + write (ifile, *) res%lowmode, res%lowmode + write (ifile, *) res%etot ! energy for comparison + call close_file(ifile) - subroutine print_charges(ifile, n, q) - implicit none - integer, intent(in) :: ifile - integer, intent(in) :: n - real(wp), intent(in) :: q(n) - integer :: i - if (ifile .ne. -1) then - do i = 1, n - write (ifile, '(f14.8)') q(i) - end do - end if - end subroutine print_charges + end if - subroutine print_mulliken(iunit, n, at, sym, xyz, z, nao, S, P, aoat2, lao2) - use xtb_scc_core, only: mpop - implicit none - integer, intent(in) :: iunit - integer, intent(in) :: n - integer, intent(in) :: at(n) - character(len=*), intent(in) :: sym(n) - real(wp), intent(in) :: xyz(3, n) - real(wp), intent(in) :: z(n) - integer, intent(in) :: nao - real(wp), intent(in) :: S(nao, nao) - real(wp), intent(in) :: P(nao, nao) - integer, intent(in) :: aoat2(nao) - integer, intent(in) :: lao2(nao) - real(wp), allocatable :: q(:) ! Mulliken partial charges - real(wp), allocatable :: qlmom(:, :) ! population per shell - real(wp), allocatable :: cm5(:) ! CM5 partial charges - real(wp), allocatable :: cm5a(:) ! CM5 partial charges - real(wp), allocatable :: dcm5a(:, :, :)! CM5 partial charges - integer :: i +end subroutine main_freq - allocate (cm5(n), q(n), qlmom(3, n), cm5a(n), dcm5a(3, n, n), source=0.0_wp) - call mpop(n, nao, aoat2, lao2, S, P, q, qlmom) - q = z - q - call calc_cm5(n, at, xyz, cm5a, dcm5a) - cm5 = q + cm5a - write (iunit, '(a)') - write (iunit, '(2x,"Mulliken/CM5 charges n(s) n(p) n(d)")') +subroutine print_charges(ifile, n, q) + implicit none + integer, intent(in) :: ifile + integer, intent(in) :: n + real(wp), intent(in) :: q(n) + integer :: i + if (ifile .ne. -1) then do i = 1, n - write (iunit, '(i6,a4,2f9.5,1x,4f7.3)') & - i, sym(i), q(i), cm5(i), qlmom(1, i), qlmom(2, i), qlmom(3, i) + write (ifile, '(f14.8)') q(i) end do - end subroutine print_mulliken + end if +end subroutine print_charges - subroutine print_wbofile(iunit, n, wbo, thr) - implicit none - integer, intent(in) :: iunit - integer, intent(in) :: n - real(wp), intent(in) :: wbo(n, n) - real(wp), intent(in) :: thr - integer :: i, j - do i = 1, n - do j = 1, i - 1 - if (wbo(j, i) > thr) write (iunit, *) j, i, wbo(j, i) - end do +subroutine print_mulliken(iunit, n, at, sym, xyz, z, nao, S, P, aoat2, lao2) + use xtb_scc_core, only: mpop + implicit none + integer, intent(in) :: iunit + integer, intent(in) :: n + integer, intent(in) :: at(n) + character(len=*), intent(in) :: sym(n) + real(wp), intent(in) :: xyz(3, n) + real(wp), intent(in) :: z(n) + integer, intent(in) :: nao + real(wp), intent(in) :: S(nao, nao) + real(wp), intent(in) :: P(nao, nao) + integer, intent(in) :: aoat2(nao) + integer, intent(in) :: lao2(nao) + real(wp), allocatable :: q(:) ! Mulliken partial charges + real(wp), allocatable :: qlmom(:, :) ! population per shell + real(wp), allocatable :: cm5(:) ! CM5 partial charges + real(wp), allocatable :: cm5a(:) ! CM5 partial charges + real(wp), allocatable :: dcm5a(:, :, :)! CM5 partial charges + integer :: i + + allocate (cm5(n), q(n), qlmom(3, n), cm5a(n), dcm5a(3, n, n), source=0.0_wp) + call mpop(n, nao, aoat2, lao2, S, P, q, qlmom) + q = z - q + call calc_cm5(n, at, xyz, cm5a, dcm5a) + cm5 = q + cm5a + write (iunit, '(a)') + write (iunit, '(2x,"Mulliken/CM5 charges n(s) n(p) n(d)")') + do i = 1, n + write (iunit, '(i6,a4,2f9.5,1x,4f7.3)') & + i, sym(i), q(i), cm5(i), qlmom(1, i), qlmom(2, i), qlmom(3, i) + end do +end subroutine print_mulliken + +subroutine print_wbofile(iunit, n, wbo, thr) + implicit none + integer, intent(in) :: iunit + integer, intent(in) :: n + real(wp), intent(in) :: wbo(n, n) + real(wp), intent(in) :: thr + integer :: i, j + do i = 1, n + do j = 1, i - 1 + if (wbo(j, i) > thr) write (iunit, *) j, i, wbo(j, i) end do - end subroutine print_wbofile + end do +end subroutine print_wbofile - subroutine print_wiberg(iunit, n, at, sym, wbo, thr) - implicit none - integer, intent(in) :: iunit - integer, intent(in) :: n - integer, intent(in) :: at(n) - character(len=*), intent(in) :: sym(n) - real(wp), intent(in) :: wbo(n, n) - real(wp), intent(in) :: thr +subroutine print_wiberg(iunit, n, at, sym, wbo, thr) + implicit none + integer, intent(in) :: iunit + integer, intent(in) :: n + integer, intent(in) :: at(n) + character(len=*), intent(in) :: sym(n) + real(wp), intent(in) :: wbo(n, n) + real(wp), intent(in) :: thr - real(wp), allocatable :: wbr(:, :) - integer, allocatable :: imem(:) - integer :: i, j, k, ibmax - real(wp) :: xsum + real(wp), allocatable :: wbr(:, :) + integer, allocatable :: imem(:) + integer :: i, j, k, ibmax + real(wp) :: xsum - allocate (wbr(n, n), source=wbo) - allocate (imem(n), source=0) + allocate (wbr(n, n), source=wbo) + allocate (imem(n), source=0) - write (iunit, '(a)') - write (iunit, '("Wiberg/Mayer (AO) data.")') - write (iunit, '("largest (>",f4.2,") Wiberg bond orders for each atom")') thr - write (iunit, '(a)') - write (iunit, '(1x,75("-"))') - write (iunit, '(5x,"#",3x,"Z",1x,"sym",2x,"total",t25,3(5x,"#",1x,"sym",2x,"WBO",2x))') - write (iunit, '(1x,75("-"))') - do i = 1, n - do j = 1, n - imem(j) = j - end do - call wibsort(n, i, imem, wbr) - ibmax = 0 - xsum = 0.0_wp - do j = 1, n - if (wbr(i, j) .gt. thr) ibmax = j - xsum = xsum + wbr(i, j) - end do - if (ibmax > 0) then - write (iunit, '(i6,1x,i3,1x,a4,f6.3,1x,"--")', advance='no') & - & i, at(i), sym(i), xsum - else - write (iunit, '(i6,1x,i3,1x,a4,f6.3)') & - & i, at(i), sym(i), xsum + write (iunit, '(a)') + write (iunit, '("Wiberg/Mayer (AO) data.")') + write (iunit, '("largest (>",f4.2,") Wiberg bond orders for each atom")') thr + write (iunit, '(a)') + write (iunit, '(1x,75("-"))') + write (iunit, '(5x,"#",3x,"Z",1x,"sym",2x,"total",t25,3(5x,"#",1x,"sym",2x,"WBO",2x))') + write (iunit, '(1x,75("-"))') + do i = 1, n + do j = 1, n + imem(j) = j + end do + call wibsort(n, i, imem, wbr) + ibmax = 0 + xsum = 0.0_wp + do j = 1, n + if (wbr(i, j) .gt. thr) ibmax = j + xsum = xsum + wbr(i, j) + end do + if (ibmax > 0) then + write (iunit, '(i6,1x,i3,1x,a4,f6.3,1x,"--")', advance='no') & + & i, at(i), sym(i), xsum + else + write (iunit, '(i6,1x,i3,1x,a4,f6.3)') & + & i, at(i), sym(i), xsum + end if + do j = 1, ibmax, 3 + if (j > 1) then + write (iunit, '(t25)', advance='no') end if - do j = 1, ibmax, 3 - if (j > 1) then - write (iunit, '(t25)', advance='no') - end if - do k = j, min(ibmax, j + 2) - write (iunit, '(i6,1x,a4,f6.3)', advance='no') & - & imem(k), sym(imem(k)), wbr(i, k) - end do - write (iunit, '(a)') + do k = j, min(ibmax, j + 2) + write (iunit, '(i6,1x,a4,f6.3)', advance='no') & + & imem(k), sym(imem(k)), wbr(i, k) end do + write (iunit, '(a)') end do - write (iunit, '(1x,75("-"))') - write (iunit, '(a)') - - deallocate (wbr, imem) - - contains - - SUBROUTINE wibsort(ncent, imo, imem, qmo) - implicit none - integer :: ncent - integer :: imo - real(wp) :: qmo(ncent, ncent) - integer :: imem(ncent) - integer :: ii, i, j, k, ihilf - real(wp) :: pp - - do ii = 2, ncent - i = ii - 1 - k = i - pp = qmo(imo, i) - do j = ii, ncent - if (qmo(imo, j) .lt. pp) cycle - k = j - pp = qmo(imo, j) - end do - if (k .eq. i) cycle - qmo(imo, k) = qmo(imo, i) - qmo(imo, i) = pp - - ihilf = imem(i) - imem(i) = imem(k) - imem(k) = ihilf - end do + end do + write (iunit, '(1x,75("-"))') + write (iunit, '(a)') - end SUBROUTINE wibsort + deallocate (wbr, imem) - end subroutine print_wiberg +contains - subroutine print_wbo_fragment(iunit, n, at, wbo, thr) - use xtb_type_atomlist + SUBROUTINE wibsort(ncent, imo, imem, qmo) implicit none - integer, intent(in) :: iunit - integer, intent(in) :: n - integer, intent(in) :: at(n) - real(wp), intent(in) :: wbo(n, n) - real(wp), intent(in) :: thr - - type(TAtomList) :: atl - - real(wp), allocatable :: bond(:, :) - integer, allocatable :: cn(:) - integer, allocatable :: fragment(:) - integer, allocatable :: list(:) - character(len=:), allocatable :: string - integer :: i, j, k, nfrag - real(wp) :: xsum - - allocate (fragment(n), cn(n), list(n), source=0) - allocate (bond(n, n), source=0.0_wp) - where (wbo > thr) - bond = min(wbo, 1.0_wp) - elsewhere - bond = 0.0_wp - end where - forall (i=1:n) cn(i) = sum(ceiling(bond(:, i))) - - call mrec(nfrag, cn, bond, n, at, fragment) + integer :: ncent + integer :: imo + real(wp) :: qmo(ncent, ncent) + integer :: imem(ncent) + integer :: ii, i, j, k, ihilf + real(wp) :: pp + + do ii = 2, ncent + i = ii - 1 + k = i + pp = qmo(imo, i) + do j = ii, ncent + if (qmo(imo, j) .lt. pp) cycle + k = j + pp = qmo(imo, j) + end do + if (k .eq. i) cycle + qmo(imo, k) = qmo(imo, i) + qmo(imo, i) = pp - write (iunit, '(a)') - if (nfrag > 1) then - write (iunit, '(1x,"*",1x,i0,1x,a)', advance='no') & - nfrag, "fragments found" - else - write (iunit, '(1x,"*",1x,a)', advance='no') & - "no fragments found" - end if - write (iunit, '(1x,"(WBO >",f5.2,")")') thr - write (iunit, '(a)') - do i = 1, nfrag - call atl%new - call atl%add(fragment .eq. i) - call atl%to_string(string) - write (iunit, '(3x,a,"(",i0,"):",1x,a)') "fragment", i, string + ihilf = imem(i) + imem(i) = imem(k) + imem(k) = ihilf end do - contains - subroutine mrec(molcount, cn, bond, n, at, molvec) - ! molcount: number of total fragments (increased during search) - ! xyz: overall Cart. coordinates - ! n: overall number of atoms - ! at: atomic number array - ! molvec: assignment vector of atom to fragment - implicit none - integer, intent(in) :: cn(n) - integer, intent(in) :: n, at(n) - integer, intent(inout) :: molvec(n), molcount - real(wp), intent(inout) :: bond(n, n) - logical, allocatable :: taken(:) - integer :: i - allocate (taken(n)) - molvec = 0 - molcount = 1 - taken = .false. - do i = 1, n - if (.not. taken(i)) then - molvec(i) = molcount - taken(i) = .true. - call neighbours(i, cn, at, taken, n, bond, molvec, molcount) - molcount = molcount + 1 - end if - end do - molcount = molcount - 1 - end subroutine mrec - - recursive subroutine neighbours(i, cn, at, taken, n, bond, & - & molvec, molcnt) - implicit none - integer, intent(in) :: cn(n) - real(wp), intent(inout) :: bond(n, n) - integer, intent(in) :: i, n, at(n) - integer, intent(inout) :: molcnt, molvec(n) - logical, intent(inout) :: taken(n) - integer :: j, icn, k - - icn = cn(i) - do k = 1, icn - j = maxloc(bond(:, i), 1) - bond(j, i) = 0 - if (i .eq. j) cycle - if (.not. taken(j)) then - molvec(j) = molcnt - taken(j) = .true. - call neighbours(j, cn, at, taken, n, bond, molvec, molcnt) - end if - end do - end subroutine neighbours - - end subroutine print_wbo_fragment + end SUBROUTINE wibsort - subroutine print_molpol(iunit, n, at, sym, xyz, q, wf, g_a, g_c, dispm) - use xtb_disp_dftd4 - use xtb_disp_ncoord - use xtb_eeq - use xtb_type_dispersionmodel - implicit none - integer, intent(in) :: iunit - integer, intent(in) :: n - integer, intent(in) :: at(n) - character(len=*), intent(in) :: sym(n) - real(wp), intent(in) :: xyz(3, n) - real(wp), intent(in) :: q(n) - real(wp), intent(in) :: wf - real(wp), intent(in) :: g_a - real(wp), intent(in) :: g_c - type(TDispersionModel), intent(in) :: dispm - - integer :: i - integer :: dispdim - real(wp) :: molpol, molc6, molc8 - real(wp), allocatable :: covcn(:) ! covalent coordination number - real(wp), allocatable :: gw(:) ! gaussian weights for references - real(wp), allocatable :: c6ref(:, :) ! unscaled reference C6 - real(wp), allocatable :: aw(:, :) ! frequency dependent polarizibilities - real(wp), allocatable :: c6ab(:, :) ! actual C6 coeffients - - call d4dim(dispm, n, at, dispdim) - allocate (covcn(n), aw(23, n), c6ab(n, n), gw(dispdim), & - c6ref(dispdim, dispdim), source=0.0_wp) - - call ncoord_d4(n, at, xyz, covcn, thr=1600.0_wp) - call d4(dispm, n, dispdim, at, wf, g_a, g_c, covcn, gw, c6ref) - call mdisp(dispm, n, dispdim, at, q, xyz, g_a, g_c, gw, c6ref, & - molc6, molc8, molpol, aout=aw, cout=c6ab) +end subroutine print_wiberg - write (iunit, '(a)') - write (iunit, '(" # Z ")', advance='no') - write (iunit, '(" covCN")', advance='no') - write (iunit, '(" q")', advance='no') - write (iunit, '(" C6AA")', advance='no') - write (iunit, '(" α(0)")', advance='no') - write (iunit, '(a)') - do i = 1, n - write (iunit, '(i6,1x,i3,1x,a4)', advance='no') & - & i, at(i), sym(i) - write (iunit, '(f10.3)', advance='no') covcn(i) - write (iunit, '(f10.3)', advance='no') q(i) - write (iunit, '(f10.3)', advance='no') c6ab(i, i) - write (iunit, '(f10.3)', advance='no') aw(1, i) - write (iunit, '(a)') - end do - write (iunit, '(/,1x,"Mol. C6AA /au·bohr⁶ :",f18.6,'// & - & '/,1x,"Mol. C8AA /au·bohr⁸ :",f18.6,'// & - & '/,1x,"Mol. α(0) /au :",f18.6,/)') & - & molc6, molc8, molpol +subroutine print_wbo_fragment(iunit, n, at, wbo, thr) + use xtb_type_atomlist + implicit none + integer, intent(in) :: iunit + integer, intent(in) :: n + integer, intent(in) :: at(n) + real(wp), intent(in) :: wbo(n, n) + real(wp), intent(in) :: thr + + type(TAtomList) :: atl + + real(wp), allocatable :: bond(:, :) + integer, allocatable :: cn(:) + integer, allocatable :: fragment(:) + integer, allocatable :: list(:) + character(len=:), allocatable :: string + integer :: i, j, k, nfrag + real(wp) :: xsum + + allocate (fragment(n), cn(n), list(n), source=0) + allocate (bond(n, n), source=0.0_wp) + where (wbo > thr) + bond = min(wbo, 1.0_wp) + elsewhere + bond = 0.0_wp + end where + forall (i=1:n) cn(i) = sum(ceiling(bond(:, i))) + + call mrec(nfrag, cn, bond, n, at, fragment) - end subroutine print_molpol + write (iunit, '(a)') + if (nfrag > 1) then + write (iunit, '(1x,"*",1x,i0,1x,a)', advance='no') & + nfrag, "fragments found" + else + write (iunit, '(1x,"*",1x,a)', advance='no') & + "no fragments found" + end if + write (iunit, '(1x,"(WBO >",f5.2,")")') thr + write (iunit, '(a)') + do i = 1, nfrag + call atl%new + call atl%add(fragment .eq. i) + call atl%to_string(string) + write (iunit, '(3x,a,"(",i0,"):",1x,a)') "fragment", i, string + end do - subroutine print_dipole(iunit, n, at, xyz, z, nao, P, dpint) - use xtb_mctc_convert +contains + subroutine mrec(molcount, cn, bond, n, at, molvec) + ! molcount: number of total fragments (increased during search) + ! xyz: overall Cart. coordinates + ! n: overall number of atoms + ! at: atomic number array + ! molvec: assignment vector of atom to fragment implicit none - integer, intent(in) :: iunit - integer, intent(in) :: n - integer, intent(in) :: at(n) - real(wp), intent(in) :: xyz(3, n) - real(wp), intent(in) :: z(n) - integer, intent(in) :: nao - real(wp), intent(in) :: P(nao, nao) - real(wp), intent(in) :: dpint(3, nao, nao) - - integer :: i, j, k - real(wp) :: d(3), dip - - ! core part - d = 0.0_wp + integer, intent(in) :: cn(n) + integer, intent(in) :: n, at(n) + integer, intent(inout) :: molvec(n), molcount + real(wp), intent(inout) :: bond(n, n) + logical, allocatable :: taken(:) + integer :: i + allocate (taken(n)) + molvec = 0 + molcount = 1 + taken = .false. do i = 1, n - d = d + xyz(:, i)*z(i) + if (.not. taken(i)) then + molvec(i) = molcount + taken(i) = .true. + call neighbours(i, cn, at, taken, n, bond, molvec, molcount) + molcount = molcount + 1 + end if end do + molcount = molcount - 1 + end subroutine mrec - ! contraction with P - k = 0 - do i = 1, nao - do j = 1, i - 1 - k = k + 1 - d = d - 2.0_wp*P(j, i)*dpint(:, i, j) - end do - k = k + 1 - d = d - P(i, i)*dpint(:, i, i) + recursive subroutine neighbours(i, cn, at, taken, n, bond, & + & molvec, molcnt) + implicit none + integer, intent(in) :: cn(n) + real(wp), intent(inout) :: bond(n, n) + integer, intent(in) :: i, n, at(n) + integer, intent(inout) :: molcnt, molvec(n) + logical, intent(inout) :: taken(n) + integer :: j, icn, k + + icn = cn(i) + do k = 1, icn + j = maxloc(bond(:, i), 1) + bond(j, i) = 0 + if (i .eq. j) cycle + if (.not. taken(j)) then + molvec(j) = molcnt + taken(j) = .true. + call neighbours(j, cn, at, taken, n, bond, molvec, molcnt) + end if end do + end subroutine neighbours - dip = norm2(d) +end subroutine print_wbo_fragment +subroutine print_molpol(iunit, n, at, sym, xyz, q, wf, g_a, g_c, dispm) + use xtb_disp_dftd4 + use xtb_disp_ncoord + use xtb_eeq + use xtb_type_dispersionmodel + implicit none + integer, intent(in) :: iunit + integer, intent(in) :: n + integer, intent(in) :: at(n) + character(len=*), intent(in) :: sym(n) + real(wp), intent(in) :: xyz(3, n) + real(wp), intent(in) :: q(n) + real(wp), intent(in) :: wf + real(wp), intent(in) :: g_a + real(wp), intent(in) :: g_c + type(TDispersionModel), intent(in) :: dispm + + integer :: i + integer :: dispdim + real(wp) :: molpol, molc6, molc8 + real(wp), allocatable :: covcn(:) ! covalent coordination number + real(wp), allocatable :: gw(:) ! gaussian weights for references + real(wp), allocatable :: c6ref(:, :) ! unscaled reference C6 + real(wp), allocatable :: aw(:, :) ! frequency dependent polarizibilities + real(wp), allocatable :: c6ab(:, :) ! actual C6 coeffients + + call d4dim(dispm, n, at, dispdim) + allocate (covcn(n), aw(23, n), c6ab(n, n), gw(dispdim), & + c6ref(dispdim, dispdim), source=0.0_wp) + + call ncoord_d4(n, at, xyz, covcn, thr=1600.0_wp) + call d4(dispm, n, dispdim, at, wf, g_a, g_c, covcn, gw, c6ref) + call mdisp(dispm, n, dispdim, at, q, xyz, g_a, g_c, gw, c6ref, & + molc6, molc8, molpol, aout=aw, cout=c6ab) + + write (iunit, '(a)') + write (iunit, '(" # Z ")', advance='no') + write (iunit, '(" covCN")', advance='no') + write (iunit, '(" q")', advance='no') + write (iunit, '(" C6AA")', advance='no') + write (iunit, '(" α(0)")', advance='no') + write (iunit, '(a)') + do i = 1, n + write (iunit, '(i6,1x,i3,1x,a4)', advance='no') & + & i, at(i), sym(i) + write (iunit, '(f10.3)', advance='no') covcn(i) + write (iunit, '(f10.3)', advance='no') q(i) + write (iunit, '(f10.3)', advance='no') c6ab(i, i) + write (iunit, '(f10.3)', advance='no') aw(1, i) write (iunit, '(a)') - write (iunit, '(1x,"dipole moment from electron density (au)")') - write (iunit, '(1x," X Y Z ")') - write (iunit, '(3f9.4," total (Debye): ",f8.3)') & - & d(1), d(2), d(3), dip*autod - write (iunit, '(a)') + end do + write (iunit, '(/,1x,"Mol. C6AA /au·bohr⁶ :",f18.6,'// & + & '/,1x,"Mol. C8AA /au·bohr⁸ :",f18.6,'// & + & '/,1x,"Mol. α(0) /au :",f18.6,/)') & + & molc6, molc8, molpol - end subroutine print_dipole +end subroutine print_molpol - subroutine print_spin_population(iunit, n, at, sym, nao, focca, foccb, S, C, aoat2, lao2) - use xtb_scc_core, only: dmat, mpop - implicit none - integer, intent(in) :: iunit ! STDOUT - integer, intent(in) :: n ! number of atoms - integer, intent(in) :: at(n) ! atom types - character(len=*), intent(in) :: sym(n) ! atom symbols - integer, intent(in) :: nao ! number of spherical atomic orbitals - real(wp), intent(in) :: focca(nao) ! fractional occupation numbers (alpha) - real(wp), intent(in) :: foccb(nao) ! fractional occupation numbers (beta) - real(wp), intent(in) :: S(nao, nao) ! overlap matrix - real(wp), intent(in) :: C(nao, nao) ! eigenvector/orbitals - integer, intent(in) :: aoat2(nao) - integer, intent(in) :: lao2(nao) +subroutine print_dipole(iunit, n, at, xyz, z, nao, P, dpint) + use xtb_mctc_convert + implicit none + integer, intent(in) :: iunit + integer, intent(in) :: n + integer, intent(in) :: at(n) + real(wp), intent(in) :: xyz(3, n) + real(wp), intent(in) :: z(n) + integer, intent(in) :: nao + real(wp), intent(in) :: P(nao, nao) + real(wp), intent(in) :: dpint(3, nao, nao) + + integer :: i, j, k + real(wp) :: d(3), dip + + ! core part + d = 0.0_wp + do i = 1, n + d = d + xyz(:, i)*z(i) + end do - integer :: i - real(wp), allocatable :: tmp(:) - real(wp), allocatable :: q(:) - real(wp), allocatable :: qlmom(:, :) - real(wp), allocatable :: X(:, :) + ! contraction with P + k = 0 + do i = 1, nao + do j = 1, i - 1 + k = k + 1 + d = d - 2.0_wp*P(j, i)*dpint(:, i, j) + end do + k = k + 1 + d = d - P(i, i)*dpint(:, i, i) + end do - allocate (tmp(nao), q(n), qlmom(3, n), X(nao, nao), source=0.0_wp) + dip = norm2(d) - write (iunit, '("(R)spin-density population")') - tmp = focca - foccb - call dmat(nao, tmp, C, X) ! X is scratch - call mpop(n, nao, aoat2, lao2, S, X, q, qlmom) - write (iunit, '(a)') - write (iunit, '(1x,"Mulliken population n(s) n(p) n(d)")') - do i = 1, n - write (iunit, '(i6,a4,1f8.4,1x,4f7.3)') & - & i, sym(i), q(i), qlmom(1, i), qlmom(2, i), qlmom(3, i) - end do + write (iunit, '(a)') + write (iunit, '(1x,"dipole moment from electron density (au)")') + write (iunit, '(1x," X Y Z ")') + write (iunit, '(3f9.4," total (Debye): ",f8.3)') & + & d(1), d(2), d(3), dip*autod + write (iunit, '(a)') - end subroutine print_spin_population +end subroutine print_dipole - subroutine print_fod_population(iunit, ifile, n, at, sym, nao, S, C, etemp, emo, ihomoa, & - & ihomob, aoat2, lao2) - use xtb_mctc_convert - use xtb_scc_core - implicit none - integer, intent(in) :: iunit ! STDOUT - integer, intent(in) :: ifile ! file handle for printout of FOD population - integer, intent(in) :: n ! number of atoms - integer, intent(in) :: at(n) ! atom types - character(len=*), intent(in) :: sym(n) ! atom symbols - integer, intent(in) :: nao ! number of spherical atomic orbitals - real(wp), intent(in) :: S(nao, nao) ! overlap matrix - real(wp), intent(in) :: C(nao, nao) ! eigenvector/orbitals - real(wp), intent(in) :: etemp ! electronic temperature - real(wp), intent(in) :: emo(nao) ! orbital energies - integer, intent(in) :: ihomoa ! position of HOMO in alpha space - integer, intent(in) :: ihomob ! position of HOMO in beta space - integer, intent(in) :: aoat2(nao) - integer, intent(in) :: lao2(nao) +subroutine print_spin_population(iunit, n, at, sym, nao, focca, foccb, S, C, aoat2, lao2) + use xtb_scc_core, only: dmat, mpop + implicit none + integer, intent(in) :: iunit ! STDOUT + integer, intent(in) :: n ! number of atoms + integer, intent(in) :: at(n) ! atom types + character(len=*), intent(in) :: sym(n) ! atom symbols + integer, intent(in) :: nao ! number of spherical atomic orbitals + real(wp), intent(in) :: focca(nao) ! fractional occupation numbers (alpha) + real(wp), intent(in) :: foccb(nao) ! fractional occupation numbers (beta) + real(wp), intent(in) :: S(nao, nao) ! overlap matrix + real(wp), intent(in) :: C(nao, nao) ! eigenvector/orbitals + integer, intent(in) :: aoat2(nao) + integer, intent(in) :: lao2(nao) + + integer :: i + real(wp), allocatable :: tmp(:) + real(wp), allocatable :: q(:) + real(wp), allocatable :: qlmom(:, :) + real(wp), allocatable :: X(:, :) + + allocate (tmp(nao), q(n), qlmom(3, n), X(nao, nao), source=0.0_wp) + + write (iunit, '("(R)spin-density population")') + tmp = focca - foccb + call dmat(nao, tmp, C, X) ! X is scratch + call mpop(n, nao, aoat2, lao2, S, X, q, qlmom) + write (iunit, '(a)') + write (iunit, '(1x,"Mulliken population n(s) n(p) n(d)")') + do i = 1, n + write (iunit, '(i6,a4,1f8.4,1x,4f7.3)') & + & i, sym(i), q(i), qlmom(1, i), qlmom(2, i), qlmom(3, i) + end do - integer :: i - real(wp), allocatable :: focc(:) ! fractional occupation numbers - real(wp), allocatable :: q(:) ! FOD populations - real(wp), allocatable :: qlmom(:, :) ! FOD populations per shell - real(wp), allocatable :: X(:, :) ! Loewdin orthonormalizer - real(wp), allocatable :: focca(:) ! fractional occupation numbers (alpha) - real(wp), allocatable :: foccb(:) ! fractional occupation numbers (beta) - real(wp) :: efa, efb, ga, gb, nfoda, nfodb - - allocate (q(n), qlmom(3, n), X(nao, nao), focca(nao), foccb(nao), focc(nao), & - source=0.0_wp) - - call makel(nao, S, C, X) - if (ihomoa + 1 .le. nao) & - call fermismear(.false., nao, ihomoa, etemp, emo, focca, nfoda, efa, ga) - if (ihomob + 1 .le. nao) & - call fermismear(.false., nao, ihomob, etemp, emo, foccb, nfodb, efb, gb) - call fodenmak(.true., nao, emo*evtoau, focca, efa) - call fodenmak(.true., nao, emo*evtoau, foccb, efb) +end subroutine print_spin_population - focc = focca + foccb - write (iunit, '(/,"NFOD :",1x,F10.4)') sum(focc) - q = 0 - qlmom = 0 - call lpop(n, nao, aoat2, lao2, focc, X, 1.0d0, q, qlmom) - write (iunit, '(a)') - write (iunit, '(" Loewdin FODpop n(s) n(p) n(d)")') +subroutine print_fod_population(iunit, ifile, n, at, sym, nao, S, C, etemp, emo, ihomoa, & + & ihomob, aoat2, lao2) + use xtb_mctc_convert + use xtb_scc_core + implicit none + integer, intent(in) :: iunit ! STDOUT + integer, intent(in) :: ifile ! file handle for printout of FOD population + integer, intent(in) :: n ! number of atoms + integer, intent(in) :: at(n) ! atom types + character(len=*), intent(in) :: sym(n) ! atom symbols + integer, intent(in) :: nao ! number of spherical atomic orbitals + real(wp), intent(in) :: S(nao, nao) ! overlap matrix + real(wp), intent(in) :: C(nao, nao) ! eigenvector/orbitals + real(wp), intent(in) :: etemp ! electronic temperature + real(wp), intent(in) :: emo(nao) ! orbital energies + integer, intent(in) :: ihomoa ! position of HOMO in alpha space + integer, intent(in) :: ihomob ! position of HOMO in beta space + integer, intent(in) :: aoat2(nao) + integer, intent(in) :: lao2(nao) + + integer :: i + real(wp), allocatable :: focc(:) ! fractional occupation numbers + real(wp), allocatable :: q(:) ! FOD populations + real(wp), allocatable :: qlmom(:, :) ! FOD populations per shell + real(wp), allocatable :: X(:, :) ! Loewdin orthonormalizer + real(wp), allocatable :: focca(:) ! fractional occupation numbers (alpha) + real(wp), allocatable :: foccb(:) ! fractional occupation numbers (beta) + real(wp) :: efa, efb, ga, gb, nfoda, nfodb + + allocate (q(n), qlmom(3, n), X(nao, nao), focca(nao), foccb(nao), focc(nao), & + source=0.0_wp) + + call makel(nao, S, C, X) + if (ihomoa + 1 .le. nao) & + call fermismear(.false., nao, ihomoa, etemp, emo, focca, nfoda, efa, ga) + if (ihomob + 1 .le. nao) & + call fermismear(.false., nao, ihomob, etemp, emo, foccb, nfodb, efb, gb) + call fodenmak(.true., nao, emo*evtoau, focca, efa) + call fodenmak(.true., nao, emo*evtoau, foccb, efb) + + focc = focca + foccb + write (iunit, '(/,"NFOD :",1x,F10.4)') sum(focc) + q = 0 + qlmom = 0 + call lpop(n, nao, aoat2, lao2, focc, X, 1.0d0, q, qlmom) + write (iunit, '(a)') + write (iunit, '(" Loewdin FODpop n(s) n(p) n(d)")') + do i = 1, n + write (iunit, '(i6,a4,f8.4,1x,4f7.3)') & + i, sym(i), q(i), qlmom(1, i), qlmom(2, i), qlmom(3, i) + end do + if (ifile .ne. -1) then do i = 1, n - write (iunit, '(i6,a4,f8.4,1x,4f7.3)') & - i, sym(i), q(i), qlmom(1, i), qlmom(2, i), qlmom(3, i) + write (ifile, '(F14.8)') q(i) end do - if (ifile .ne. -1) then - do i = 1, n - write (ifile, '(F14.8)') q(i) - end do - end if + end if - end subroutine print_fod_population +end subroutine print_fod_population - subroutine print_thermo(iunit, nat, nvib_in, at, xyz, freq, etot, htot, gtot, nimag, pr, zp) - use xtb_mctc_convert - use xtb_readin - use xtb_setparam - use xtb_axis, only: axis2 - use xtb_thermo - implicit none - integer, intent(in) :: iunit - logical, intent(in) :: pr - integer, intent(in) :: nat - integer, intent(in) :: at(nat) - integer, intent(in) :: nvib_in - real(wp), intent(in) :: freq(3*nat) - real(wp), intent(in) :: xyz(3, nat) - real(wp), intent(in) :: etot - real(wp), intent(out) :: gtot - real(wp), intent(out) :: htot - real(wp), intent(out) :: zp - - real(wp) xx(10), sthr, temp, scale_factor - real(wp) aa, bb, cc, vibthr, ithr - real(wp) escf, symnum, wt, avmom, diff - real(wp) :: omega, maxfreq, fswitch, lnq_r, lnq_v - real(wp), allocatable :: et(:), ht(:), gt(:), ts(:) - integer nn, nvib, i, j, k, n, nvib_theo, isthr - integer, intent(out) :: nimag - real(wp), allocatable :: vibs(:), tmp(:) - character(len=*), parameter :: outfmt = & - '(9x,"::",1x,a,f24.12,1x,a,1x,"::")' - character(len=*), parameter :: dblfmt = & - '(10x,":",2x,a,f24.7,1x,a,1x,":")' - character(len=*), parameter :: intfmt = & - '(10x,":",2x,a,i24, 6x,":")' - character(len=*), parameter :: chrfmt = & - '(10x,":",2x,a,a24, 6x,":")' - - logical linear, atom, da - - allocate (et(set%nthermo), ht(set%nthermo), gt(set%nthermo), ts(set%nthermo), & - & vibs(3*nat), tmp(3*nat), source=0.0_wp) - - ! frequencies read in are considered - ! as being real if .gt. this value in cm-1 - ! this threshold requires projected freqs.! - vibthr = 1.0 - ithr = set%thermo_ithr - - atom = .false. - linear = .false. - sthr = set%thermo_sthr - if (abs(set%thermo_fscal - 1.0_wp) > 1.0e-8_wp) then - scale_factor = set%thermo_fscal +subroutine print_thermo(iunit, nat, nvib_in, at, xyz, freq, etot, htot, gtot, nimag, pr, zp) + use xtb_mctc_convert + use xtb_readin + use xtb_setparam + use xtb_axis, only: axis2 + use xtb_thermo + implicit none + integer, intent(in) :: iunit + logical, intent(in) :: pr + integer, intent(in) :: nat + integer, intent(in) :: at(nat) + integer, intent(in) :: nvib_in + real(wp), intent(in) :: freq(3*nat) + real(wp), intent(in) :: xyz(3, nat) + real(wp), intent(in) :: etot + real(wp), intent(out) :: gtot + real(wp), intent(out) :: htot + real(wp), intent(out) :: zp + + real(wp) xx(10), sthr, temp, scale_factor + real(wp) aa, bb, cc, vibthr, ithr + real(wp) escf, symnum, wt, avmom, diff + real(wp) :: omega, maxfreq, fswitch, lnq_r, lnq_v + real(wp), allocatable :: et(:), ht(:), gt(:), ts(:) + integer nn, nvib, i, j, k, n, nvib_theo, isthr + integer, intent(out) :: nimag + real(wp), allocatable :: vibs(:), tmp(:) + character(len=*), parameter :: outfmt = & + '(9x,"::",1x,a,f24.12,1x,a,1x,"::")' + character(len=*), parameter :: dblfmt = & + '(10x,":",2x,a,f24.7,1x,a,1x,":")' + character(len=*), parameter :: intfmt = & + '(10x,":",2x,a,i24, 6x,":")' + character(len=*), parameter :: chrfmt = & + '(10x,":",2x,a,a24, 6x,":")' + + logical linear, atom, da + + allocate (et(set%nthermo), ht(set%nthermo), gt(set%nthermo), ts(set%nthermo), & + & vibs(3*nat), tmp(3*nat), source=0.0_wp) + + ! frequencies read in are considered + ! as being real if .gt. this value in cm-1 + ! this threshold requires projected freqs.! + vibthr = 1.0 + ithr = set%thermo_ithr + + atom = .false. + linear = .false. + sthr = set%thermo_sthr + if (abs(set%thermo_fscal - 1.0_wp) > 1.0e-8_wp) then + scale_factor = set%thermo_fscal + else + if (set%mode_extrun .eq. p_ext_gfnff) then + scale_factor = 1.03_wp else - if (set%mode_extrun .eq. p_ext_gfnff) then - scale_factor = 1.03_wp - else - scale_factor = 1.0_wp - end if + scale_factor = 1.0_wp end if - nvib = 0 - nimag = 0 - - call axis2(nat, at, xyz, aa, bb, cc, avmom, wt) + end if + nvib = 0 + nimag = 0 - nvib_theo = 3*nat - 6 - if (cc .lt. 1.d-10) linear = .true. - if (linear) nvib_theo = 3*nat - 5 + call axis2(nat, at, xyz, aa, bb, cc, avmom, wt) - if (aa + bb + cc .lt. 1.d-6) then - atom = .true. - nvib = 0 - nvib_theo = 0 - end if + nvib_theo = 3*nat - 6 + if (cc .lt. 1.d-10) linear = .true. + if (linear) nvib_theo = 3*nat - 5 - ! the rotational number - call getsymmetry(pr, iunit, nat, at, xyz, set%desy, set%maxatdesy, set%pgroup) - call getsymnum(set%pgroup, linear, symnum) + if (aa + bb + cc .lt. 1.d-6) then + atom = .true. + nvib = 0 + nvib_theo = 0 + end if - vibs = 0 - do i = 1, 3*nat - if (abs(freq(i)) .gt. vibthr .and. i .le. nvib_in) then - nvib = nvib + 1 - vibs(nvib) = freq(i) - end if - end do + ! the rotational number + call getsymmetry(pr, iunit, nat, at, xyz, set%desy, set%maxatdesy, set%pgroup) + call getsymnum(set%pgroup, linear, symnum) - ! scale - vibs(1:nvib) = vibs(1:nvib)*scale_factor + vibs = 0 + do i = 1, 3*nat + if (abs(freq(i)) .gt. vibthr .and. i .le. nvib_in) then + nvib = nvib + 1 + vibs(nvib) = freq(i) + end if + end do - do i = 1, nvib - ! artifacts - if (vibs(i) .lt. 0 .and. vibs(i) .gt. ithr) then - vibs(i) = -vibs(i) - if (pr) write (iunit, *) 'inverting freq ', i, vibs(i) - end if - end do - tmp = vibs + ! scale + vibs(1:nvib) = vibs(1:nvib)*scale_factor - k = nvib - nvib = 0 - j = 0 - diff = abs(maxval(vibs) - set%thermo_sthr) - do i = 1, k - if (tmp(i) .gt. 0) then - nvib = nvib + 1 - if (abs(tmp(i) - set%thermo_sthr) < diff) then - diff = abs(tmp(i) - set%thermo_sthr) - isthr = nvib - end if - vibs(nvib) = tmp(i)*rcmtoau ! work in atomic units, seriously - else - j = j + 1 + do i = 1, nvib + ! artifacts + if (vibs(i) .lt. 0 .and. vibs(i) .gt. ithr) then + vibs(i) = -vibs(i) + if (pr) write (iunit, *) 'inverting freq ', i, vibs(i) + end if + end do + tmp = vibs + + k = nvib + nvib = 0 + j = 0 + diff = abs(maxval(vibs) - set%thermo_sthr) + do i = 1, k + if (tmp(i) .gt. 0) then + nvib = nvib + 1 + if (abs(tmp(i) - set%thermo_sthr) < diff) then + diff = abs(tmp(i) - set%thermo_sthr) + isthr = nvib end if - end do - nimag = j - - if (pr) then - write (iunit, '(a)') - write (iunit, '(10x,51("."))') - write (iunit, '(10x,":",22x,a,22x,":")') "SETUP" - write (iunit, '(10x,":",49("."),":")') - write (iunit, intfmt) "# frequencies ", nvib - write (iunit, intfmt) "# imaginary freq.", nimag - write (iunit, chrfmt) "linear? ", bool2string(linear) - write (iunit, chrfmt) "only rotor calc. ", bool2string(nvib .eq. 0) - write (iunit, chrfmt) "symmetry ", trim(set%pgroup) - write (iunit, intfmt) "rotational number", int(symnum) - write (iunit, dblfmt) "scaling factor ", scale_factor, " " - write (iunit, dblfmt) "rotor cutoff ", set%thermo_sthr, "cm⁻¹" - write (iunit, dblfmt) "imag. cutoff ", ithr, "cm⁻¹" - write (iunit, '(10x,":",49("."),":")') + vibs(nvib) = tmp(i)*rcmtoau ! work in atomic units, seriously + else + j = j + 1 end if + end do + nimag = j - call print_thermo_sthr_ts(iunit, nvib, vibs, avmom, set%thermo_sthr, set%thermotemp(set%nthermo)) - - ! do calc. - zp = 0.5_wp*sum(vibs(1:nvib)) - do i = 1, set%nthermo - temp = set%thermotemp(i) - call thermodyn(iunit, aa, bb, cc, avmom, linear, atom, symnum, wt, vibs, nvib, escf, & - & temp, sthr, et(i), ht(i), gt(i), ts(i), zp, pr) - !call oldthermo(aa,bb,cc,avmom,linear,atom,symnum,wt,vibs,nvib,escf, & - ! & temp,sthr,et(i),ht(i),gt(i),ts(i),zp,pr) - end do - + if (pr) then write (iunit, '(a)') - write (iunit, '(a10)', advance='no') "T/K" - write (iunit, '(a16)', advance='no') "H(0)-H(T)+PV" - write (iunit, '(a16)', advance='no') "H(T)/Eh" - write (iunit, '(a16)', advance='no') "T*S/Eh" - write (iunit, '(a16)', advance='no') "G(T)/Eh" - write (iunit, '(a)') - write (iunit, '(3x,72("-"))') - do i = 1, set%nthermo - write (iunit, '(3f10.2)', advance='no') set%thermotemp(i) - write (iunit, '(3e16.6)', advance='no') ht(i) - write (iunit, '(3e16.6)', advance='no') et(i) - write (iunit, '(3e16.6)', advance='no') ts(i) - write (iunit, '(3e16.6)', advance='no') gt(i) - if (i .eq. set%nthermo .and. set%nthermo .gt. 1) then - write (iunit, '(1x,"(used)")') - else - write (iunit, '(a)') - end if - end do - write (iunit, '(3x,72("-"))') - - gtot = gt(set%nthermo) - htot = et(set%nthermo) + write (iunit, '(10x,51("."))') + write (iunit, '(10x,":",22x,a,22x,":")') "SETUP" + write (iunit, '(10x,":",49("."),":")') + write (iunit, intfmt) "# frequencies ", nvib + write (iunit, intfmt) "# imaginary freq.", nimag + write (iunit, chrfmt) "linear? ", bool2string(linear) + write (iunit, chrfmt) "only rotor calc. ", bool2string(nvib .eq. 0) + write (iunit, chrfmt) "symmetry ", trim(set%pgroup) + write (iunit, intfmt) "rotational number", int(symnum) + write (iunit, dblfmt) "scaling factor ", scale_factor, " " + write (iunit, dblfmt) "rotor cutoff ", set%thermo_sthr, "cm⁻¹" + write (iunit, dblfmt) "imag. cutoff ", ithr, "cm⁻¹" + write (iunit, '(10x,":",49("."),":")') + end if - write (iunit, '(a)') - write (iunit, '(9x,53(":"))') - write (iunit, '(9x,"::",18x,a,18x,"::")') "THERMODYNAMIC" - write (iunit, '(9x,53(":"))') - write (iunit, outfmt) "total free energy ", gtot + etot, "Eh " - write (iunit, '(9x,"::",49("."),"::")') - write (iunit, outfmt) "total energy ", etot, "Eh " - write (iunit, outfmt) "zero point energy ", zp, "Eh " - write (iunit, outfmt) "G(RRHO) w/o ZPVE ", gtot - zp, "Eh " - write (iunit, outfmt) "G(RRHO) contrib. ", gtot, "Eh " - write (iunit, '(9x,53(":"))') - - end subroutine print_thermo - - subroutine print_thermo_sthr_lnq(iunit, nvib, vibs, avmom, sthr, temp) - use xtb_mctc_convert - use xtb_thermo - implicit none - integer, intent(in) :: iunit - integer, intent(in) :: nvib - real(wp), intent(in) :: vibs(nvib) - real(wp), intent(in) :: avmom - real(wp), intent(in) :: sthr - real(wp), intent(in) :: temp + call print_thermo_sthr_ts(iunit, nvib, vibs, avmom, set%thermo_sthr, set%thermotemp(set%nthermo)) - integer :: i - real(wp) :: maxfreq, omega, lnq_r, lnq_v, fswitch + ! do calc. + zp = 0.5_wp*sum(vibs(1:nvib)) + do i = 1, set%nthermo + temp = set%thermotemp(i) + call thermodyn(iunit, aa, bb, cc, avmom, linear, atom, symnum, wt, vibs, nvib, escf, & + & temp, sthr, et(i), ht(i), gt(i), ts(i), zp, pr) + !call oldthermo(aa,bb,cc,avmom,linear,atom,symnum,wt,vibs,nvib,escf, & + ! & temp,sthr,et(i),ht(i),gt(i),ts(i),zp,pr) + end do - write (iunit, '(a)') - maxfreq = max(300.0_wp, chg_inverted(0.99_wp, sthr)) - write (iunit, '(a8,a14,a12,10x,a12,10x,a12)') & - "mode", "ω/cm⁻¹", "ln{qvib}", "ln{qrot}", "ln{qtot}" - write (iunit, '(3x,72("-"))') - do i = 1, nvib - omega = vibs(i)*autorcm - lnq_r = lnqvib(temp, omega) - lnq_v = lnqrot(temp, omega, avmom) - fswitch = 1.0_wp - chg_switching(omega, sthr) - if (omega > maxfreq) exit - write (iunit, '(i8,f10.2,2(f12.5,1x,"(",f6.2,"%)"),f12.5)') & - i, omega, lnq_v, (1.0_wp - fswitch)*100, & - lnq_r, fswitch*100, (1.0_wp - fswitch)*lnq_v + fswitch*lnq_r - end do - write (iunit, '(3x,72("-"))') + write (iunit, '(a)') + write (iunit, '(a10)', advance='no') "T/K" + write (iunit, '(a16)', advance='no') "H(0)-H(T)+PV" + write (iunit, '(a16)', advance='no') "H(T)/Eh" + write (iunit, '(a16)', advance='no') "T*S/Eh" + write (iunit, '(a16)', advance='no') "G(T)/Eh" + write (iunit, '(a)') + write (iunit, '(3x,72("-"))') + do i = 1, set%nthermo + write (iunit, '(3f10.2)', advance='no') set%thermotemp(i) + write (iunit, '(3e16.6)', advance='no') ht(i) + write (iunit, '(3e16.6)', advance='no') et(i) + write (iunit, '(3e16.6)', advance='no') ts(i) + write (iunit, '(3e16.6)', advance='no') gt(i) + if (i .eq. set%nthermo .and. set%nthermo .gt. 1) then + write (iunit, '(1x,"(used)")') + else + write (iunit, '(a)') + end if + end do + write (iunit, '(3x,72("-"))') - end subroutine print_thermo_sthr_lnq + gtot = gt(set%nthermo) + htot = et(set%nthermo) - subroutine print_thermo_sthr_ts(iunit, nvib, vibs, avmom_si, sthr_rcm, temp) - use xtb_mctc_constants - use xtb_mctc_convert - use xtb_thermo - implicit none + write (iunit, '(a)') + write (iunit, '(9x,53(":"))') + write (iunit, '(9x,"::",18x,a,18x,"::")') "THERMODYNAMIC" + write (iunit, '(9x,53(":"))') + write (iunit, outfmt) "total free energy ", gtot + etot, "Eh " + write (iunit, '(9x,"::",49("."),"::")') + write (iunit, outfmt) "total energy ", etot, "Eh " + write (iunit, outfmt) "zero point energy ", zp, "Eh " + write (iunit, outfmt) "G(RRHO) w/o ZPVE ", gtot - zp, "Eh " + write (iunit, outfmt) "G(RRHO) contrib. ", gtot, "Eh " + write (iunit, '(9x,53(":"))') + +end subroutine print_thermo + +subroutine print_thermo_sthr_lnq(iunit, nvib, vibs, avmom, sthr, temp) + use xtb_mctc_convert + use xtb_thermo + implicit none + integer, intent(in) :: iunit + integer, intent(in) :: nvib + real(wp), intent(in) :: vibs(nvib) + real(wp), intent(in) :: avmom + real(wp), intent(in) :: sthr + real(wp), intent(in) :: temp - integer, intent(in) :: iunit !< output unit, usually STDOUT - integer, intent(in) :: nvib !< number of frequencies - real(wp), intent(in) :: vibs(nvib) !< frequencies in Eh - real(wp), intent(in) :: avmom_si !< average moment - real(wp), intent(in) :: sthr_rcm !< rotor cutoff - real(wp), intent(in) :: temp !< temperature - - integer :: i - real(wp) :: maxfreq, omega, s_r, s_v, fswitch - real(wp) :: beta, xxmom, e, ewj, mu, RT, sthr, avmom - beta = 1.0_wp/kB/temp ! beta in 1/Eh - sthr = sthr_rcm*rcmtoau ! sthr in Eh - RT = kb*temp*autokcal ! RT in kcal/mol for printout - avmom = avmom_si*kgtome*aatoau**2*1.0e+20_wp ! in me·α² + integer :: i + real(wp) :: maxfreq, omega, lnq_r, lnq_v, fswitch - write (iunit, '(a)') - maxfreq = max(300.0_wp, chg_inverted(0.99_wp, sthr_rcm)) - write (iunit, '(a8,a14,1x,a27,a27,a12)') & - "mode", "ω/cm⁻¹", "T·S(HO)/kcal·mol⁻¹", "T·S(FR)/kcal·mol⁻¹", "T·S(vib)" - write (iunit, '(3x,72("-"))') - do i = 1, nvib - ! frequency is Eh - omega = vibs(i) - ! omega in Eh, beta in 1/Eh - ewj = exp(-omega*beta) - ! moment of intertia corresponding to the rotor with frequency omega - ! mu is in me·α² (au) - mu = 0.5_wp/(omega + 1.0e-14_wp) - ! this reduced moment limits the rotational moment of inertia for - ! this vibration to that of the total molecule rotation/3 - ! avmom and mu are in au - mu = mu*avmom/(mu + avmom) - ! free rotor entropy - ! Cramer, page 328 for one degree of freedom or - ! http://cccbdb.nist.gov/thermo.asp, eq. 35, sigma=1 - ! harm. osc. entropy - if (omega .gt. 0) then - ! this is S/R which is dimensionless - s_v = omega*beta*ewj/(1.0_wp - ewj) - log(1.0_wp - ewj) - s_r = 0.5_wp + log(sqrt(pi/beta*2.0_wp*mu)) - else - s_v = 0.0_wp - s_r = 0.0_wp - end if - ! Head-Gordon weighting - fswitch = 1.0_wp - chg_switching(omega, sthr) - if (omega > maxfreq*rcmtoau) exit - write (iunit, '(i8,f10.2,2(f12.5,1x,"(",f6.2,"%)"),f12.5)') & - i, omega*autorcm, -RT*s_v, (1.0_wp - fswitch)*100, & - -RT*s_r, fswitch*100, -RT*((1.0_wp - fswitch)*s_v + fswitch*s_r) - end do - write (iunit, '(3x,72("-"))') + write (iunit, '(a)') + maxfreq = max(300.0_wp, chg_inverted(0.99_wp, sthr)) + write (iunit, '(a8,a14,a12,10x,a12,10x,a12)') & + "mode", "ω/cm⁻¹", "ln{qvib}", "ln{qrot}", "ln{qtot}" + write (iunit, '(3x,72("-"))') + do i = 1, nvib + omega = vibs(i)*autorcm + lnq_r = lnqvib(temp, omega) + lnq_v = lnqrot(temp, omega, avmom) + fswitch = 1.0_wp - chg_switching(omega, sthr) + if (omega > maxfreq) exit + write (iunit, '(i8,f10.2,2(f12.5,1x,"(",f6.2,"%)"),f12.5)') & + i, omega, lnq_v, (1.0_wp - fswitch)*100, & + lnq_r, fswitch*100, (1.0_wp - fswitch)*lnq_v + fswitch*lnq_r + end do + write (iunit, '(3x,72("-"))') - end subroutine print_thermo_sthr_ts +end subroutine print_thermo_sthr_lnq - subroutine print_gbsa_info(iunit, sym, gbsa) - use xtb_mctc_constants - use xtb_mctc_convert - use xtb_solv_gbsa, only: TBorn - implicit none - integer, intent(in) :: iunit - character(len=*), intent(in) :: sym(:) - type(TBorn), intent(in) :: gbsa +subroutine print_thermo_sthr_ts(iunit, nvib, vibs, avmom_si, sthr_rcm, temp) + use xtb_mctc_constants + use xtb_mctc_convert + use xtb_thermo + implicit none - integer :: i + integer, intent(in) :: iunit !< output unit, usually STDOUT + integer, intent(in) :: nvib !< number of frequencies + real(wp), intent(in) :: vibs(nvib) !< frequencies in Eh + real(wp), intent(in) :: avmom_si !< average moment + real(wp), intent(in) :: sthr_rcm !< rotor cutoff + real(wp), intent(in) :: temp !< temperature + + integer :: i + real(wp) :: maxfreq, omega, s_r, s_v, fswitch + real(wp) :: beta, xxmom, e, ewj, mu, RT, sthr, avmom + beta = 1.0_wp/kB/temp ! beta in 1/Eh + sthr = sthr_rcm*rcmtoau ! sthr in Eh + RT = kb*temp*autokcal ! RT in kcal/mol for printout + avmom = avmom_si*kgtome*aatoau**2*1.0e+20_wp ! in me·α² - write (iunit, '(a)') - write (iunit, '(1x,"*",1x,a)') & - & "generalized Born model for continuum solvation" - write (iunit, '(a)') - if (gbsa%lhb) then - write (iunit, '(2x,2a4,5x,3a)') "#", "Z", "Born rad/Å", " SASA/Ų", " H-bond" - do i = 1, size(sym) - write (iunit, '(i6,1x,i3,1x,a4,3f10.3)') & - & i, gbsa%at(i), sym(i), & - & gbsa%brad(i)*autoaa, gbsa%sasa(i)*fourpi*autoaa**2, & - & gbsa%hbw(i) - end do + write (iunit, '(a)') + maxfreq = max(300.0_wp, chg_inverted(0.99_wp, sthr_rcm)) + write (iunit, '(a8,a14,1x,a27,a27,a12)') & + "mode", "ω/cm⁻¹", "T·S(HO)/kcal·mol⁻¹", "T·S(FR)/kcal·mol⁻¹", "T·S(vib)" + write (iunit, '(3x,72("-"))') + do i = 1, nvib + ! frequency is Eh + omega = vibs(i) + ! omega in Eh, beta in 1/Eh + ewj = exp(-omega*beta) + ! moment of intertia corresponding to the rotor with frequency omega + ! mu is in me·α² (au) + mu = 0.5_wp/(omega + 1.0e-14_wp) + ! this reduced moment limits the rotational moment of inertia for + ! this vibration to that of the total molecule rotation/3 + ! avmom and mu are in au + mu = mu*avmom/(mu + avmom) + ! free rotor entropy + ! Cramer, page 328 for one degree of freedom or + ! http://cccbdb.nist.gov/thermo.asp, eq. 35, sigma=1 + ! harm. osc. entropy + if (omega .gt. 0) then + ! this is S/R which is dimensionless + s_v = omega*beta*ewj/(1.0_wp - ewj) - log(1.0_wp - ewj) + s_r = 0.5_wp + log(sqrt(pi/beta*2.0_wp*mu)) else - write (iunit, '(2x,2a4,5x,2a)') "#", "Z", "Born rad/Å", " SASA/Ų" - do i = 1, size(sym) - write (iunit, '(i6,1x,i3,1x,a4,2f10.3)') & - & i, gbsa%at(i), sym(i), & - & gbsa%brad(i)*autoaa, gbsa%sasa(i)*fourpi*autoaa**2 - end do + s_v = 0.0_wp + s_r = 0.0_wp end if - write (iunit, '(/,1x,"total SASA / Ų :",f13.3)') & - & sum(gbsa%sasa)*fourpi*autoaa**2 - - end subroutine print_gbsa_info + ! Head-Gordon weighting + fswitch = 1.0_wp - chg_switching(omega, sthr) + if (omega > maxfreq*rcmtoau) exit + write (iunit, '(i8,f10.2,2(f12.5,1x,"(",f6.2,"%)"),f12.5)') & + i, omega*autorcm, -RT*s_v, (1.0_wp - fswitch)*100, & + -RT*s_r, fswitch*100, -RT*((1.0_wp - fswitch)*s_v + fswitch*s_r) + end do + write (iunit, '(3x,72("-"))') -end module xtb_propertyoutput +end subroutine print_thermo_sthr_ts -subroutine print_orbital_eigenvalues(iunit, wfn, range) - use xtb_mctc_accuracy, only: wp +subroutine print_gbsa_info(iunit, sym, gbsa) + use xtb_mctc_constants use xtb_mctc_convert - use xtb_type_wavefunction + use xtb_solv_gbsa, only: TBorn implicit none integer, intent(in) :: iunit - integer, intent(in) :: range - type(TWavefunction), intent(in) :: wfn - character(len=*), parameter :: hlfmt = '( a24,f21.7,1x,"Eh",f18.4,1x,"eV")' - integer :: maxorb, minorb, iorb - real(wp) :: gap + character(len=*), intent(in) :: sym(:) + type(TBorn), intent(in) :: gbsa - minorb = max(wfn%ihomoa - (range + 1), 1) - maxorb = min(wfn%ihomoa + range, wfn%nao) - gap = wfn%emo(wfn%ihomoa + 1) - wfn%emo(wfn%ihomoa) + integer :: i write (iunit, '(a)') - write (iunit, '(a10,a14,a21,a21)') "#", "Occupation", "Energy/Eh", "Energy/eV" - write (iunit, '(6x,61("-"))') - if (minorb .gt. 1) then - call write_line(1, wfn%focc, wfn%emo, wfn%ihomo) - if (minorb .gt. 2) & - write (iunit, '(a10,a14,a21,a21)') "...", "...", "...", "..." + write (iunit, '(1x,"*",1x,a)') & + & "generalized Born model for continuum solvation" + write (iunit, '(a)') + if (gbsa%lhb) then + write (iunit, '(2x,2a4,5x,3a)') "#", "Z", "Born rad/Å", " SASA/Ų", " H-bond" + do i = 1, size(sym) + write (iunit, '(i6,1x,i3,1x,a4,3f10.3)') & + & i, gbsa%at(i), sym(i), & + & gbsa%brad(i)*autoaa, gbsa%sasa(i)*fourpi*autoaa**2, & + & gbsa%hbw(i) + end do + else + write (iunit, '(2x,2a4,5x,2a)') "#", "Z", "Born rad/Å", " SASA/Ų" + do i = 1, size(sym) + write (iunit, '(i6,1x,i3,1x,a4,2f10.3)') & + & i, gbsa%at(i), sym(i), & + & gbsa%brad(i)*autoaa, gbsa%sasa(i)*fourpi*autoaa**2 + end do end if - do iorb = minorb, maxorb - call write_line(iorb, wfn%focc, wfn%emo, wfn%ihomo) - end do - if (maxorb .lt. wfn%nao) then - if (maxorb .lt. wfn%nao - 1) then - if (wfn%focc(maxorb) > 1.0e-7_wp) then - write (iunit, '(a10,a14,a21,a21)') "...", "...", "...", "..." - else - write (iunit, '(a10,a14,a21,a21)') "...", "", "...", "..." - end if + write (iunit, '(/,1x,"total SASA / Ų :",f13.3)') & + & sum(gbsa%sasa)*fourpi*autoaa**2 + +end subroutine print_gbsa_info + +end module xtb_propertyoutput + +subroutine print_orbital_eigenvalues(iunit, wfn, range) +use xtb_mctc_accuracy, only: wp +use xtb_mctc_convert +use xtb_type_wavefunction +implicit none +integer, intent(in) :: iunit +integer, intent(in) :: range +type(TWavefunction), intent(in) :: wfn +character(len=*), parameter :: hlfmt = '( a24,f21.7,1x,"Eh",f18.4,1x,"eV")' +integer :: maxorb, minorb, iorb +real(wp) :: gap + +minorb = max(wfn%ihomoa - (range + 1), 1) +maxorb = min(wfn%ihomoa + range, wfn%nao) +gap = wfn%emo(wfn%ihomoa + 1) - wfn%emo(wfn%ihomoa) + +write (iunit, '(a)') +write (iunit, '(a10,a14,a21,a21)') "#", "Occupation", "Energy/Eh", "Energy/eV" +write (iunit, '(6x,61("-"))') +if (minorb .gt. 1) then + call write_line(1, wfn%focc, wfn%emo, wfn%ihomo) + if (minorb .gt. 2) & + write (iunit, '(a10,a14,a21,a21)') "...", "...", "...", "..." +end if +do iorb = minorb, maxorb + call write_line(iorb, wfn%focc, wfn%emo, wfn%ihomo) +end do +if (maxorb .lt. wfn%nao) then + if (maxorb .lt. wfn%nao - 1) then + if (wfn%focc(maxorb) > 1.0e-7_wp) then + write (iunit, '(a10,a14,a21,a21)') "...", "...", "...", "..." + else + write (iunit, '(a10,a14,a21,a21)') "...", "", "...", "..." end if - call write_line(wfn%nao, wfn%focc, wfn%emo, wfn%ihomo) end if - write (iunit, '(6x,61("-"))') - write (iunit, hlfmt) "HL-Gap", gap*evtoau, gap - write (iunit, hlfmt) "Fermi-level", (wfn%efa + wfn%efb)/2*evtoau, (wfn%efa + wfn%efb)/2 + call write_line(wfn%nao, wfn%focc, wfn%emo, wfn%ihomo) +end if +write (iunit, '(6x,61("-"))') +write (iunit, hlfmt) "HL-Gap", gap*evtoau, gap +write (iunit, hlfmt) "Fermi-level", (wfn%efa + wfn%efb)/2*evtoau, (wfn%efa + wfn%efb)/2 contains - subroutine write_line(iorb, focc, emo, ihomo) - integer, intent(in) :: iorb - integer, intent(in) :: ihomo - real(wp), intent(in) :: focc(:) - real(wp), intent(in) :: emo(:) - character(len=*), parameter :: mofmt = '(i10,f14.4,f21.7,f21.4)' - character(len=*), parameter :: vofmt = '(i10,14x, f21.7,f21.4)' - if (focc(iorb) < 1.0e-7_wp) then - write (iunit, vofmt, advance='no') iorb, emo(iorb)*evtoau, emo(iorb) - else - write (iunit, mofmt, advance='no') iorb, focc(iorb), emo(iorb)*evtoau, emo(iorb) - end if - if (iorb == ihomo) then - write (iunit, '(1x,"(HOMO)")') - elseif (iorb == ihomo + 1) then - write (iunit, '(1x,"(LUMO)")') - else - write (iunit, '(a)') - end if - end subroutine write_line +subroutine write_line(iorb, focc, emo, ihomo) + integer, intent(in) :: iorb + integer, intent(in) :: ihomo + real(wp), intent(in) :: focc(:) + real(wp), intent(in) :: emo(:) + character(len=*), parameter :: mofmt = '(i10,f14.4,f21.7,f21.4)' + character(len=*), parameter :: vofmt = '(i10,14x, f21.7,f21.4)' + if (focc(iorb) < 1.0e-7_wp) then + write (iunit, vofmt, advance='no') iorb, emo(iorb)*evtoau, emo(iorb) + else + write (iunit, mofmt, advance='no') iorb, focc(iorb), emo(iorb)*evtoau, emo(iorb) + end if + if (iorb == ihomo) then + write (iunit, '(1x,"(HOMO)")') + elseif (iorb == ihomo + 1) then + write (iunit, '(1x,"(LUMO)")') + else + write (iunit, '(a)') + end if +end subroutine write_line end subroutine print_orbital_eigenvalues diff --git a/src/main/setup.f90 b/src/main/setup.f90 index b2924da96..478d304b8 100644 --- a/src/main/setup.f90 +++ b/src/main/setup.f90 @@ -45,181 +45,181 @@ module xtb_main_setup contains - subroutine newCalculator(env, mol, calc, fname, restart, accuracy, input, iff_data, tblite_input) +subroutine newCalculator(env, mol, calc, fname, restart, accuracy, input, iff_data, tblite_input) - character(len=*), parameter :: source = 'main_setup_newCalculator' + character(len=*), parameter :: source = 'main_setup_newCalculator' - type(TEnvironment), intent(inout) :: env + type(TEnvironment), intent(inout) :: env - type(TMolecule), intent(in) :: mol + type(TMolecule), intent(in) :: mol - class(TCalculator), allocatable, intent(out) :: calc + class(TCalculator), allocatable, intent(out) :: calc - character(len=*), intent(in) :: fname + character(len=*), intent(in) :: fname - logical, intent(in) :: restart + logical, intent(in) :: restart - real(wp), intent(in) :: accuracy + real(wp), intent(in) :: accuracy - type(oniom_input), intent(in), optional :: input + type(oniom_input), intent(in), optional :: input - type(TIFFData), intent(in), optional, allocatable :: iff_data + type(TIFFData), intent(in), optional, allocatable :: iff_data - !> Input for TBLite calculator - type(TTBLiteInput), intent(in), optional :: tblite_input + !> Input for TBLite calculator + type(TTBLiteInput), intent(in), optional :: tblite_input - type(TxTBCalculator), allocatable :: xtb - type(TTBLiteCalculator), allocatable :: tblite - type(TGFFCalculator), allocatable :: gfnff - type(TIFFCalculator), allocatable :: iff - type(TOrcaCalculator), allocatable :: orca - type(TMopacCalculator), allocatable :: mopac - type(TTMCalculator), allocatable :: turbo - type(TOniomCalculator), allocatable :: oniom - type(TDriverCalculator), allocatable :: driver - type(TPTBCalculator), allocatable :: ptb + type(TxTBCalculator), allocatable :: xtb + type(TTBLiteCalculator), allocatable :: tblite + type(TGFFCalculator), allocatable :: gfnff + type(TIFFCalculator), allocatable :: iff + type(TOrcaCalculator), allocatable :: orca + type(TMopacCalculator), allocatable :: mopac + type(TTMCalculator), allocatable :: turbo + type(TOniomCalculator), allocatable :: oniom + type(TDriverCalculator), allocatable :: driver + type(TPTBCalculator), allocatable :: ptb - logical :: exitRun + logical :: exitRun - select case (set%mode_extrun) - case default - call env%error("Unknown calculator type", source) + select case (set%mode_extrun) + case default + call env%error("Unknown calculator type", source) - case (p_ext_oniom) - if (.not. present(input)) then - call env%error("ONIOM calculator requires input", source) - return - end if - allocate (oniom) - call newOniomCalculator(oniom, env, mol, input) - call move_alloc(oniom, calc) + case (p_ext_oniom) + if (.not. present(input)) then + call env%error("ONIOM calculator requires input", source) + return + end if + allocate (oniom) + call newOniomCalculator(oniom, env, mol, input) + call move_alloc(oniom, calc) - case (p_ext_eht, p_ext_xtb) - allocate (xtb) + case (p_ext_eht, p_ext_xtb) + allocate (xtb) - call newXTBCalculator(env, mol, xtb, fname, set%gfn_method, accuracy) + call newXTBCalculator(env, mol, xtb, fname, set%gfn_method, accuracy) - call env%check(exitRun) - if (exitRun) then - call env%error("Could not construct new calculator", source) - return - end if + call env%check(exitRun) + if (exitRun) then + call env%error("Could not construct new calculator", source) + return + end if - call move_alloc(xtb, calc) - case (p_ext_tblite) - if (.not. present(tblite_input)) then - call env%error("TBLite calculator requires input", source) - return - end if - allocate (tblite) + call move_alloc(xtb, calc) + case (p_ext_tblite) + if (.not. present(tblite_input)) then + call env%error("TBLite calculator requires input", source) + return + end if + allocate (tblite) - call newTBLiteCalculator(env, mol, tblite, tblite_input) + call newTBLiteCalculator(env, mol, tblite, tblite_input) - call env%check(exitRun) - if (exitRun) then - call env%error("Could not construct new calculator", source) - return - end if + call env%check(exitRun) + if (exitRun) then + call env%error("Could not construct new calculator", source) + return + end if - call move_alloc(tblite, calc) - case (p_ext_gfnff) - allocate (gfnff) + call move_alloc(tblite, calc) + case (p_ext_gfnff) + allocate (gfnff) - call newGFFCalculator(env, mol, gfnff, fname, restart) + call newGFFCalculator(env, mol, gfnff, fname, restart) - call env%check(exitRun) - if (exitRun) then - call env%error("Could not construct new calculator", source) - return - end if + call env%check(exitRun) + if (exitRun) then + call env%error("Could not construct new calculator", source) + return + end if - call move_alloc(gfnff, calc) - case (p_ext_iff) - if (.not. present(iff_data)) then - call env%error("IFF calculator requires input", source) - return - end if - allocate (iff) + call move_alloc(gfnff, calc) + case (p_ext_iff) + if (.not. present(iff_data)) then + call env%error("IFF calculator requires input", source) + return + end if + allocate (iff) - if (.not. allocated(iff_data)) then - call env%error("IFF Data not present for Calculator", source) - end if + if (.not. allocated(iff_data)) then + call env%error("IFF Data not present for Calculator", source) + end if - call newIFFCalculator(env, mol, iff_data, iff) + call newIFFCalculator(env, mol, iff_data, iff) - call env%check(exitRun) - if (exitRun) then - call env%error("Could not construct new calculator", source) - return - end if + call env%check(exitRun) + if (exitRun) then + call env%error("Could not construct new calculator", source) + return + end if - call move_alloc(iff, calc) - - case (p_ext_ptb) - allocate (ptb) - - call newPTBCalculator(env, mol, ptb) - - call env%check(exitRun) - if (exitRun) then - call env%error("Could not construct new calculator", source) - return - end if - - call move_alloc(ptb, calc) - - case (p_ext_orca) - allocate (orca) - call newOrcaCalculator(orca, env, set%ext_orca) - call move_alloc(orca, calc) - - case (p_ext_mopac) - allocate (mopac) - call newMopacCalculator(mopac, env, set%ext_mopac) - call move_alloc(mopac, calc) - - case (p_ext_turbomole) - allocate (turbo) - call newTMCalculator(turbo, set%extcode, set%extmode) - call move_alloc(turbo, calc) - - case (p_ext_driver) - allocate (driver) - call newDriverCalculator(driver, env, set%ext_driver) - call move_alloc(driver, calc) - end select + call move_alloc(iff, calc) + + case (p_ext_ptb) + allocate (ptb) - end subroutine newCalculator + call newPTBCalculator(env, mol, ptb) - subroutine addSolvationModel(env, calc, input) - type(TEnvironment), intent(inout) :: env - class(TCalculator), intent(inout) :: calc - type(TSolvInput), intent(in) :: input - integer :: level + call env%check(exitRun) + if (exitRun) then + call env%error("Could not construct new calculator", source) + return + end if - level = 0 - select type (calc) + call move_alloc(ptb, calc) + + case (p_ext_orca) + allocate (orca) + call newOrcaCalculator(orca, env, set%ext_orca) + call move_alloc(orca, calc) + + case (p_ext_mopac) + allocate (mopac) + call newMopacCalculator(mopac, env, set%ext_mopac) + call move_alloc(mopac, calc) + + case (p_ext_turbomole) + allocate (turbo) + call newTMCalculator(turbo, set%extcode, set%extmode) + call move_alloc(turbo, calc) + + case (p_ext_driver) + allocate (driver) + call newDriverCalculator(driver, env, set%ext_driver) + call move_alloc(driver, calc) + end select + +end subroutine newCalculator + +subroutine addSolvationModel(env, calc, input) + type(TEnvironment), intent(inout) :: env + class(TCalculator), intent(inout) :: calc + type(TSolvInput), intent(in) :: input + integer :: level + + level = 0 + select type (calc) + type is (TxTBCalculator) + level = calc%xtbData%level + type is (TOniomCalculator) + select type (xtb => calc%real_low) type is (TxTBCalculator) - level = calc%xtbData%level - type is (TOniomCalculator) - select type (xtb => calc%real_low) - type is (TxTBCalculator) - level = xtb%xtbData%level - end select + level = xtb%xtbData%level end select + end select - if (allocated(input%solvent)) then - calc%lSolv = input%solvent /= 'none' .and. input%solvent /= 'gas' & - & .and. input%solvent /= 'vac' - else - calc%lSolv = .false. - end if + if (allocated(input%solvent)) then + calc%lSolv = input%solvent /= 'none' .and. input%solvent /= 'gas' & + & .and. input%solvent /= 'vac' + else + calc%lSolv = .false. + end if - if (calc%lSolv) then - allocate (calc%solvation) - call init(calc%solvation, env, input, level) - end if + if (calc%lSolv) then + allocate (calc%solvation) + call init(calc%solvation, env, input, level) + end if - end subroutine addSolvationModel +end subroutine addSolvationModel end module xtb_main_setup diff --git a/src/prog/main.F90 b/src/prog/main.F90 index 8bf6763a0..44edefb20 100644 --- a/src/prog/main.F90 +++ b/src/prog/main.F90 @@ -112,448 +112,437 @@ module xtb_prog_main contains - subroutine xtbMain(env, argParser) +subroutine xtbMain(env, argParser) - !> Source of errors in the main program unit - character(len=*), parameter :: source = "prog_main" + !> Source of errors in the main program unit + character(len=*), parameter :: source = "prog_main" - type(TEnvironment), intent(inout) :: env + type(TEnvironment), intent(inout) :: env - type(TArgParser), intent(inout) :: argParser + type(TArgParser), intent(inout) :: argParser !! ======================================================================== ! use some wrapper types to bundle information together - type(TMolecule) :: mol - type(scc_results) :: res - class(TCalculator), allocatable :: calc, cpxcalc - type(freq_results) :: fres - type(TRestart) :: chk - type(chrg_parameter) :: chrgeq - type(TIFFData), allocatable :: iff_data - type(oniom_input) :: oniom - type(jab_input) :: dipro - type(TCpcmx) :: cpx - type(TTBLiteInput) :: tblite + type(TMolecule) :: mol + type(scc_results) :: res + class(TCalculator), allocatable :: calc, cpxcalc + type(freq_results) :: fres + type(TRestart) :: chk + type(chrg_parameter) :: chrgeq + type(TIFFData), allocatable :: iff_data + type(oniom_input) :: oniom + type(jab_input) :: dipro + type(TCpcmx) :: cpx + type(TTBLiteInput) :: tblite ! store important names and stuff like that in FORTRAN strings - character(len=:), allocatable :: fname ! geometry input file - character(len=:), allocatable :: xcontrol ! instruction file - character(len=:), allocatable :: xrc ! global instruction file - character(len=:), allocatable :: fnv ! parameter file - character(len=:), allocatable :: tmpname ! temporary string - character(len=:), allocatable :: cdum ! temporary string - character(len=:), allocatable :: extension, basename, directory - integer :: ftype + character(len=:), allocatable :: fname ! geometry input file + character(len=:), allocatable :: xcontrol ! instruction file + character(len=:), allocatable :: xrc ! global instruction file + character(len=:), allocatable :: fnv ! parameter file + character(len=:), allocatable :: tmpname ! temporary string + character(len=:), allocatable :: cdum ! temporary string + character(len=:), allocatable :: extension, basename, directory + integer :: ftype !! ======================================================================== ! default names for important files in xtb - character(len=*), parameter :: p_fname_rc = '.xtbrc' - character(len=*), parameter :: p_fname_param_gfn0 = 'param_gfn0-xtb.txt' - character(len=*), parameter :: p_fname_param_gfn1 = 'param_gfn1-xtb.txt' - character(len=*), parameter :: p_fname_param_gfn2 = 'param_gfn2-xtb.txt' - character(len=*), parameter :: p_fname_param_gfnff = '.param_gfnff.xtb' - character(len=*), parameter :: p_fname_param_ipea = 'param_ipea-xtb.txt' - character(len=*), parameter :: p_fname_param_ptb = 'param_ptb.txt' - - integer :: gsolvstate - integer :: i, j, k, l, idum - integer :: ich, ictrl, iprop ! file handle - real(wp) :: sigma(3, 3) - real(wp), allocatable :: cn(:) - real(wp), allocatable :: sat(:) - real(wp), allocatable :: g(:, :) - real(wp), allocatable :: fukui(:, :) - real(wp) :: vec3(3) - type(TxTBParameter) :: globpar - real(wp), allocatable :: dcn(:, :, :) - real(wp), allocatable :: dq(:, :, :) - real(wp), allocatable :: dumdumdum(:, :, :) - real(wp), allocatable :: q(:) - real(wp), allocatable :: ql(:) - real(wp), allocatable :: qr(:) + character(len=*), parameter :: p_fname_rc = '.xtbrc' + character(len=*), parameter :: p_fname_param_gfn0 = 'param_gfn0-xtb.txt' + character(len=*), parameter :: p_fname_param_gfn1 = 'param_gfn1-xtb.txt' + character(len=*), parameter :: p_fname_param_gfn2 = 'param_gfn2-xtb.txt' + character(len=*), parameter :: p_fname_param_gfnff = '.param_gfnff.xtb' + character(len=*), parameter :: p_fname_param_ipea = 'param_ipea-xtb.txt' + character(len=*), parameter :: p_fname_param_ptb = 'param_ptb.txt' + + integer :: gsolvstate + integer :: i, j, k, l, idum + integer :: ich, ictrl, iprop ! file handle + real(wp) :: sigma(3, 3) + real(wp), allocatable :: cn(:) + real(wp), allocatable :: sat(:) + real(wp), allocatable :: g(:, :) + real(wp), allocatable :: fukui(:, :) + real(wp) :: vec3(3) + type(TxTBParameter) :: globpar + real(wp), allocatable :: dcn(:, :, :) + real(wp), allocatable :: dq(:, :, :) + real(wp), allocatable :: dumdumdum(:, :, :) + real(wp), allocatable :: q(:) + real(wp), allocatable :: ql(:) + real(wp), allocatable :: qr(:) !! ------------------------------------------------------------------------ - integer, external :: ncore + integer, external :: ncore !! ------------------------------------------------------------------------ - logical :: struc_conversion_done = .false. - logical :: anyopt + logical :: struc_conversion_done = .false. + logical :: anyopt !! ======================================================================== ! debugging variables for numerical gradient - logical, parameter :: gen_param = .false. - logical, parameter :: debug = .false. - type(TRestart) :: wf0 - real(wp), allocatable :: coord(:, :), numg(:, :), gdum(:, :) - real(wp) :: sdum(3, 3) - real(wp), parameter :: step = 0.00001_wp, step2 = 0.5_wp/step - real(wp) :: er, el - logical :: coffee ! if debugging gets really though, get a coffee + logical, parameter :: gen_param = .false. + logical, parameter :: debug = .false. + type(TRestart) :: wf0 + real(wp), allocatable :: coord(:, :), numg(:, :), gdum(:, :) + real(wp) :: sdum(3, 3) + real(wp), parameter :: step = 0.00001_wp, step2 = 0.5_wp/step + real(wp) :: er, el + logical :: coffee ! if debugging gets really though, get a coffee !! ------------------------------------------------------------------------ ! undocumented and unexplainable variables go here - integer :: nFiles, iFile - integer :: rohf, err - real(wp) :: dum5, egap, etot, ipeashift - real(wp) :: zero, t0, t1, w0, w1, etot2, g298 - real(wp) :: one, two - real(wp) :: ea, ip - real(wp) :: vomega - real(wp) :: energy_gas - parameter(zero=0.0_wp) - parameter(one=1.0_wp) - parameter(two=2.0_wp) - logical :: ex, okbas - logical :: epr, diff, murks - logical :: exist - logical :: lgrad, restart - logical :: copycontrol - logical :: newreader - logical :: strict - logical :: exitRun - logical :: cold_fusion + integer :: nFiles, iFile + integer :: rohf, err + real(wp) :: dum5, egap, etot, ipeashift + real(wp) :: zero, t0, t1, w0, w1, etot2, g298 + real(wp) :: one, two + real(wp) :: ea, ip + real(wp) :: vomega + real(wp) :: energy_gas + parameter(zero=0.0_wp) + parameter(one=1.0_wp) + parameter(two=2.0_wp) + logical :: ex, okbas + logical :: epr, diff, murks + logical :: exist + logical :: lgrad, restart + logical :: copycontrol + logical :: newreader + logical :: strict + logical :: exitRun + logical :: cold_fusion ! OMP stuff - integer :: TID, OMP_GET_NUM_THREADS, OMP_GET_THREAD_NUM - integer :: nproc - - type(TPrintTopo) :: printTopo ! gfnff topology printout list - - xenv%home = env%xtbhome - xenv%path = env%xtbpath - - ! ------------------------------------------------------------------------ - !> read the command line arguments - - call parseArguments(env, argParser, xcontrol, fnv, lgrad, & - & restart, gsolvstate, strict, copycontrol, coffee, printTopo, oniom, dipro, tblite) - - !> Spin-polarization is only available in the tblite library - if (set%mode_extrun .ne. p_ext_tblite .and. tblite%spin_polarized) then - call env%error("Spin-polarization is only available with the tblite library! Try --tblite", source) - end if - - !> If hessian (or ohess or bhess) is requested in combination with PTB, conduct GFN2-xTB + PTB hessian - if (set%mode_extrun .eq. p_ext_ptb .and. (set%runtyp .eq. p_run_hess .or. set%runtyp .eq. p_run_ohess .or. set%runtyp .eq. p_run_bhess)) then - set%mode_extrun = p_ext_xtb - set%ptbsetup%ptb_in_hessian = .true. - ! if (set%gfn_method == 2) set%ptbsetup%hessmethod = "gfn2" - ! if (set%gfn_method == 1) set%ptbsetup%hessmethod = "gfn1" - ! if (set%gfn_method == 0) set%ptbsetup%hessmethod = "gfn0" - ! if (set%gfn_method == -1) then - call set_gfn(env, 'method', '2') - call set_gfn(env, 'd4', 'true') - tblite%method = "gfn2" - set%ptbsetup%hessmethod = "GFN2-xTB" - ! end if + integer :: TID, OMP_GET_NUM_THREADS, OMP_GET_THREAD_NUM + integer :: nproc + + type(TPrintTopo) :: printTopo ! gfnff topology printout list + + xenv%home = env%xtbhome + xenv%path = env%xtbpath + + ! ------------------------------------------------------------------------ + !> read the command line arguments + + call parseArguments(env, argParser, xcontrol, fnv, lgrad, & + & restart, gsolvstate, strict, copycontrol, coffee, printTopo, oniom, dipro, tblite) + + !> Spin-polarization is only available in the tblite library + if (set%mode_extrun .ne. p_ext_tblite .and. tblite%spin_polarized) then + call env%error("Spin-polarization is only available with the tblite library! Try --tblite", source) + end if + + !> If hessian (or ohess or bhess) is requested in combination with PTB, conduct GFN2-xTB + PTB hessian + if (set%mode_extrun .eq. p_ext_ptb .and. (set%runtyp .eq. p_run_hess .or. set%runtyp .eq. p_run_ohess .or. set%runtyp .eq. p_run_bhess)) then + set%mode_extrun = p_ext_xtb + set%ptbsetup%ptb_in_hessian = .true. + ! if (set%gfn_method == 2) set%ptbsetup%hessmethod = "gfn2" + ! if (set%gfn_method == 1) set%ptbsetup%hessmethod = "gfn1" + ! if (set%gfn_method == 0) set%ptbsetup%hessmethod = "gfn0" + ! if (set%gfn_method == -1) then + call set_gfn(env, 'method', '2') + call set_gfn(env, 'd4', 'true') + tblite%method = "gfn2" + set%ptbsetup%hessmethod = "GFN2-xTB" + ! end if + end if + + nFiles = argParser%countFiles() + select case (nFiles) + case (0) + if (.not. coffee) then + if (printTopo%warning) call env%error("Eventually the input file was given to wrtopo as an argument.", source) + call env%error("No input file given, so there is nothing to do", source) + else + fname = 'coffee' end if - - nFiles = argParser%countFiles() - select case (nFiles) - case (0) - if (.not. coffee) then - if (printTopo%warning) call env%error("Eventually the input file was given to wrtopo as an argument.", source) - call env%error("No input file given, so there is nothing to do", source) - else - fname = 'coffee' - end if - case (1:) - do iFile = 1, nFiles - 1 - call argParser%nextFile(fname) - call env%warning("Input file '"//fname//"' will be ignored", source) - end do + case (1:) + do iFile = 1, nFiles - 1 call argParser%nextFile(fname) - end select + call env%warning("Input file '"//fname//"' will be ignored", source) + end do + call argParser%nextFile(fname) + end select - if (.not. allocated(xcontrol)) then - if (copycontrol) then - xcontrol = 'xtb.inp' - else - xcontrol = fname - end if + if (.not. allocated(xcontrol)) then + if (copycontrol) then + xcontrol = 'xtb.inp' + else + xcontrol = fname end if + end if - anyopt = ((set%runtyp .eq. p_run_opt) .or. (set%runtyp .eq. p_run_ohess) .or. & - & (set%runtyp .eq. p_run_omd) .or. (set%runtyp .eq. p_run_screen) .or. & - & (set%runtyp .eq. p_run_metaopt)) + anyopt = ((set%runtyp .eq. p_run_opt) .or. (set%runtyp .eq. p_run_ohess) .or. & + & (set%runtyp .eq. p_run_omd) .or. (set%runtyp .eq. p_run_screen) .or. & + & (set%runtyp .eq. p_run_metaopt)) - if (allocated(set%solvInput%cpxsolvent) .and. anyopt) call env%terminate("CPCM-X not implemented for geometry optimization. & - &Please use another solvation model for optimization instead.") - if ((set%mode_extrun == p_ext_ptb) .and. anyopt) call env%terminate("PTB not implemented for geometry optimization. & - &Please use another method for optimization instead.") + if (allocated(set%solvInput%cpxsolvent) .and. anyopt) call env%terminate("CPCM-X not implemented for geometry optimization. & + &Please use another solvation model for optimization instead.") + if ((set%mode_extrun == p_ext_ptb) .and. anyopt) call env%terminate("PTB not implemented for geometry optimization. & + &Please use another method for optimization instead.") - call env%checkpoint("Command line argument parsing failed") - - ! ------------------------------------------------------------------------ - !> read the detailed input file - call rdcontrol(xcontrol, env, copy_file=copycontrol) - - call env%checkpoint("Reading '"//xcontrol//"' failed") - - ! ------------------------------------------------------------------------ - !> read dot-Files before reading the rc and after reading the xcontrol - !> Total molecular charge - call open_file(ich, '.CHRG', 'r') - if (ich .ne. -1) then - call getline(ich, cdum, iostat=err) - if (err /= 0) then - call env%error('.CHRG is empty!', source) - else - call set_chrg(env, cdum) - call close_file(ich) - end if - end if + call env%checkpoint("Command line argument parsing failed") - call env%checkpoint("Reading charge from file failed") + ! ------------------------------------------------------------------------ + !> read the detailed input file + call rdcontrol(xcontrol, env, copy_file=copycontrol) - !> Number of unpaired electrons - call open_file(ich, '.UHF', 'r') - if (ich .ne. -1) then - call getline(ich, cdum, iostat=err) - if (err /= 0) then - call env%error('.UHF is empty!', source) - else - call set_spin(env, cdum) - call close_file(ich) - end if - end if + call env%checkpoint("Reading '"//xcontrol//"' failed") - !> efield read: gfnff and PTB only - if (set%mode_extrun .eq. p_ext_gfnff .or. set%mode_extrun .eq. p_ext_ptb) then - call open_file(ich, '.EFIELD', 'r') - if (ich .ne. -1) then - call getline(ich, cdum, iostat=err) - if (err /= 0) then - call env%error('.EFIELD is empty!', source) - else - call set_efield(env, cdum) - call close_file(ich) - end if - end if - end if - !> If EFIELD is not zero when using xtb, print a warning - if (((set%mode_extrun /= p_ext_ptb) .and. (set%mode_extrun /= p_ext_gfnff)) & - & .and. (sum(abs(set%efield)) /= 0.0_wp) ) then - call env%terminate("External electric field is not zero ('--efield' or file '.EFIELD'), & - & but only supported for GFN-FF and PTB") + ! ------------------------------------------------------------------------ + !> read dot-Files before reading the rc and after reading the xcontrol + !> Total molecular charge + call open_file(ich, '.CHRG', 'r') + if (ich .ne. -1) then + call getline(ich, cdum, iostat=err) + if (err /= 0) then + call env%error('.CHRG is empty!', source) else + call set_chrg(env, cdum) + call close_file(ich) end if + end if - call env%checkpoint("Reading multiplicity from file failed") + call env%checkpoint("Reading charge from file failed") - ! ------------------------------------------------------------------------ - !> read the xtbrc if you can find it (use rdpath directly instead of xfind) - call rdpath(env%xtbpath, p_fname_rc, xrc, exist) - if (exist) then - call rdcontrol(xrc, env, copy_file=.false.) - - call env%checkpoint("Reading '"//xrc//"' failed") - end if - - ! ------------------------------------------------------------------------ - !> FIXME: some settings that are still not automatic - !> Make sure GFN0-xTB uses the correct exttyp - if (set%gfn_method == 0) call set_exttyp('eht') - rohf = 1 ! HS default - egap = 0.0_wp - ipeashift = 0.0_wp - - ! ======================================================================== - !> no user interaction up to now, time to show off! - !> print the xtb banner with version number and compilation date - !> making a fancy version of this is hard, x is difficult in ASCII art - call xtb_header(env%unit) - !> make sure you cannot blame us for destroying your computer - call disclamer(env%unit) - !> how to cite this program - call citation(env%unit) - !> print current time - call prdate('S') - - ! ------------------------------------------------------------------------ - !> get molecular structure - if (coffee) then ! it's coffee time - fname = 'caffeine' - call get_coffee(mol) - call generateFileMetaInfo(fname, directory, basename, extension) + !> Number of unpaired electrons + call open_file(ich, '.UHF', 'r') + if (ich .ne. -1) then + call getline(ich, cdum, iostat=err) + if (err /= 0) then + call env%error('.UHF is empty!', source) else - call generateFileMetaInfo(fname, directory, basename, extension) - ftype = getFileType(fname) - call open_file(ich, fname, 'r') - call readMolecule(env, mol, ich, ftype) + call set_spin(env, cdum) call close_file(ich) - if (mol%info%two_dimensional) then - call env%warning("Two dimensional input structure detected", source) - end if - - ! Special CT input file case - if (mol%chrg /= 0.0_wp) then - if (set%clichrg) then - call env%warning("Charge in sdf/mol input was overwritten", source) - else - set%ichrg = nint(mol%chrg) - end if - end if - - call env%checkpoint("reading geometry input '"//fname//"' failed") end if + end if - ! ------------------------------------------------------------------------ - !> initialize the global storage - call init_fix(mol%n) - call init_split(mol%n) - call init_constr(mol%n, mol%at) - call init_scan - call init_walls - call init_pcem - if (set%runtyp .eq. p_run_bhess) then - call init_bhess(mol%n) - else - call init_metadyn(mol%n, metaset%maxsave) - end if - call load_rmsdbias(rmsdset, mol%n, mol%at, mol%xyz) - - ! ------------------------------------------------------------------------ - !> get some memory - allocate (cn(mol%n), sat(mol%n), g(3, mol%n), source=0.0_wp) - atmass = atomic_mass(mol%at)*autoamu ! from splitparam.f90 - set%periodic = mol%npbc > 0 - if (mol%npbc == 0) then - if (set%do_cma_trafo) then - allocate (coord(3, mol%n), source=0.0_wp) - call axis3(1, mol%n, mol%at, mol%xyz, coord, vec3) - mol%xyz = coord - deallocate (coord) + !> efield read: gfnff and PTB only + if (set%mode_extrun .eq. p_ext_gfnff .or. set%mode_extrun .eq. p_ext_ptb) then + call open_file(ich, '.EFIELD', 'r') + if (ich .ne. -1) then + call getline(ich, cdum, iostat=err) + if (err /= 0) then + call env%error('.EFIELD is empty!', source) + else + call set_efield(env, cdum) + call close_file(ich) end if end if - - do i = 1, mol%n - mol%z(i) = mol%at(i) - ncore(mol%at(i)) - ! lanthanides without f are treated as La - if (mol%at(i) .gt. 57 .and. mol%at(i) .lt. 72) mol%z(i) = 3 - end do - - !> initialize time step for MD if requested autocomplete - if (set%tstep_md < 0.0_wp) then - set%tstep_md = (minval(atmass)/(atomic_mass(1)*autoamu))**(1.0_wp/3.0_wp) - end if - - mol%chrg = real(set%ichrg, wp) - !! To assign charge - mol%uhf = set%nalphabeta - call initrand - - call setup_summary(env%unit, mol%n, fname, xcontrol, chk%wfn, xrc) - - ! ------------------------------------------------------------------------ - !> 2D => 3D STRUCTURE CONVERTER - ! ------------------------------------------------------------------------ + end if + !> If EFIELD is not zero when using xtb, print a warning + if (((set%mode_extrun /= p_ext_ptb) .and. (set%mode_extrun /= p_ext_gfnff)) & + & .and. (sum(abs(set%efield)) /= 0.0_wp) ) then + call env%terminate("External electric field is not zero ('--efield' or file '.EFIELD'), & + & but only supported for GFN-FF and PTB") + else + end if + + call env%checkpoint("Reading multiplicity from file failed") + + ! ------------------------------------------------------------------------ + !> read the xtbrc if you can find it (use rdpath directly instead of xfind) + call rdpath(env%xtbpath, p_fname_rc, xrc, exist) + if (exist) then + call rdcontrol(xrc, env, copy_file=.false.) + + call env%checkpoint("Reading '"//xrc//"' failed") + end if + + ! ------------------------------------------------------------------------ + !> FIXME: some settings that are still not automatic + !> Make sure GFN0-xTB uses the correct exttyp + if (set%gfn_method == 0) call set_exttyp('eht') + rohf = 1 ! HS default + egap = 0.0_wp + ipeashift = 0.0_wp + + ! ======================================================================== + !> no user interaction up to now, time to show off! + !> print the xtb banner with version number and compilation date + !> making a fancy version of this is hard, x is difficult in ASCII art + call xtb_header(env%unit) + !> make sure you cannot blame us for destroying your computer + call disclamer(env%unit) + !> how to cite this program + call citation(env%unit) + !> print current time + call prdate('S') + + ! ------------------------------------------------------------------------ + !> get molecular structure + if (coffee) then ! it's coffee time + fname = 'caffeine' + call get_coffee(mol) + call generateFileMetaInfo(fname, directory, basename, extension) + else + call generateFileMetaInfo(fname, directory, basename, extension) + ftype = getFileType(fname) + call open_file(ich, fname, 'r') + call readMolecule(env, mol, ich, ftype) + call close_file(ich) if (mol%info%two_dimensional) then - call struc_convert(env, restart, mol, chk, egap, set%etemp, set%maxscciter, & - & set%optset%maxoptcycle, etot, g, sigma) - struc_conversion_done = .true. - mol%info%two_dimensional = .false. + call env%warning("Two dimensional input structure detected", source) end if - ! ------------------------------------------------------------------------ - !> CONSTRAINTS & SCANS - !> now we are at a point that we can check for requested constraints - call read_userdata(xcontrol, env, mol) - - if (sum(abs(set%efield)) /= 0.0_wp) then - write (env%unit, '(/,3x,a)') "--------------------------------------" - write (env%unit, '(3x,a)') "--- external electric field / a.u. ---" - write (env%unit, '(3x,3(a,f8.4))') "x = ", set%efield(1), " y = ", set%efield(2), " z = ", set%efield(3) - write (env%unit, '(3x,a)') "--------------------------------------" - end if - - !> initialize metadynamics - call load_metadynamic(metaset, mol%n, mol%at, mol%xyz) - - !> restraining potential - if (allocated(potset%xyz)) then - if (lconstr_all_bonds) call constrain_all_bonds(mol%n, mol%at, potset%xyz) - if (lconstr_all_angles) call constrain_all_angles(mol%n, mol%at, potset%xyz) - if (lconstr_all_torsions) call constrain_all_torsions(mol%n, mol%at, potset%xyz) - call setup_constrain_pot(mol%n, mol%at, potset%xyz) - else - if (lconstr_all_bonds) call constrain_all_bonds(mol%n, mol%at, mol%xyz) - if (lconstr_all_angles) call constrain_all_angles(mol%n, mol%at, mol%xyz) - if (lconstr_all_torsions) call constrain_all_torsions(mol%n, mol%at, mol%xyz) - call setup_constrain_pot(mol%n, mol%at, mol%xyz) - end if - ! fragmentation for CMA constrain - if (iatf1 .eq. 0 .and. iatf2 .eq. 0) then - call ncoord_erf(mol%n, mol%at, mol%xyz, cn) - call splitm(mol%n, mol%at, mol%xyz, cn) - end if - call splitprint(mol%n, mol%at, mol%xyz) - - if (set%verbose) then - call fix_info(env%unit, mol%n, mol%at, mol%xyz) - call pot_info(env%unit, mol%n, mol%at, mol%xyz) - end if - - ! ------------------------------------------------------------------------ - !> write copy of detailed input - if (copycontrol) then - call open_set(ictrl, xcontrol) - call write_set(ictrl) - call close_set(ictrl) - end if - - ! ------------------------------------------------------------------------ - !> if you have requested a define we stop here... - if (set%define) then - if (set%verbose) call main_geometry(env%unit, mol) - call eval_define(set%veryverbose) - end if - call env%show('Please study the warnings concerning your input carefully') - call raise('F', 'Please study the warnings concerning your input carefully') - - ! ======================================================================== - !> From here we switch to the method setup - !> enable error on warnings - if (strict) call mctc_strict - env%strict = strict - - !> one last check on the input geometry - call check_cold_fusion(env, mol, cold_fusion) - if (cold_fusion) then - call env%error("XTB REFUSES TO CONTINUE WITH THIS CALCULATION!") - call env%terminate("Some atoms in the start geometry are *very* close") + ! Special CT input file case + if (mol%chrg /= 0.0_wp) then + if (set%clichrg) then + call env%warning("Charge in sdf/mol input was overwritten", source) + else + set%ichrg = nint(mol%chrg) + end if end if - !> check if someone is still using GFN3... - if (set%gfn_method .eq. 3) then - call env%terminate('Wait for some months - for now, please use gfn_method=2!') + call env%checkpoint("reading geometry input '"//fname//"' failed") + end if + + ! ------------------------------------------------------------------------ + !> initialize the global storage + call init_fix(mol%n) + call init_split(mol%n) + call init_constr(mol%n, mol%at) + call init_scan + call init_walls + call init_pcem + if (set%runtyp .eq. p_run_bhess) then + call init_bhess(mol%n) + else + call init_metadyn(mol%n, metaset%maxsave) + end if + call load_rmsdbias(rmsdset, mol%n, mol%at, mol%xyz) + + ! ------------------------------------------------------------------------ + !> get some memory + allocate (cn(mol%n), sat(mol%n), g(3, mol%n), source=0.0_wp) + atmass = atomic_mass(mol%at)*autoamu ! from splitparam.f90 + set%periodic = mol%npbc > 0 + if (mol%npbc == 0) then + if (set%do_cma_trafo) then + allocate (coord(3, mol%n), source=0.0_wp) + call axis3(1, mol%n, mol%at, mol%xyz, coord, vec3) + mol%xyz = coord + deallocate (coord) end if - - ! ------------------------------------------------------------------------ - !> Print the method header and select the parameter file - - if ((.not. allocated(fnv)) .and. (.not. set%mode_extrun .eq. p_ext_ptb)) then - select case (set%runtyp) - case default - call env%terminate('This is an internal error, please define your runtypes!') - case (p_run_scc, p_run_grad, p_run_opt, p_run_hess, p_run_ohess, p_run_bhess, & - p_run_md, p_run_omd, p_run_path, p_run_screen, & - p_run_modef, p_run_mdopt, p_run_metaopt) - if (set%mode_extrun .eq. p_ext_gfnff) then - fnv = xfind(p_fname_param_gfnff) - ! elseif (set%mode_extrun .eq. p_ext_ptb) then - ! fnv = xfind(p_fname_param_ptb) - else - if (set%gfn_method .eq. 0) then - fnv = xfind(p_fname_param_gfn0) - end if - if (set%gfn_method .eq. 1) then - fnv = xfind(p_fname_param_gfn1) - end if - if (set%gfn_method .eq. 2) then - fnv = xfind(p_fname_param_gfn2) - end if - end if - case (p_run_vip, p_run_vea, p_run_vipea, p_run_vfukui, p_run_vomega) + end if + + do i = 1, mol%n + mol%z(i) = mol%at(i) - ncore(mol%at(i)) + ! lanthanides without f are treated as La + if (mol%at(i) .gt. 57 .and. mol%at(i) .lt. 72) mol%z(i) = 3 + end do + + !> initialize time step for MD if requested autocomplete + if (set%tstep_md < 0.0_wp) then + set%tstep_md = (minval(atmass)/(atomic_mass(1)*autoamu))**(1.0_wp/3.0_wp) + end if + + mol%chrg = real(set%ichrg, wp) + !! To assign charge + mol%uhf = set%nalphabeta + call initrand + + call setup_summary(env%unit, mol%n, fname, xcontrol, chk%wfn, xrc) + + ! ------------------------------------------------------------------------ + !> 2D => 3D STRUCTURE CONVERTER + ! ------------------------------------------------------------------------ + if (mol%info%two_dimensional) then + call struc_convert(env, restart, mol, chk, egap, set%etemp, set%maxscciter, & + & set%optset%maxoptcycle, etot, g, sigma) + struc_conversion_done = .true. + mol%info%two_dimensional = .false. + end if + + ! ------------------------------------------------------------------------ + !> CONSTRAINTS & SCANS + !> now we are at a point that we can check for requested constraints + call read_userdata(xcontrol, env, mol) + + if (sum(abs(set%efield)) /= 0.0_wp) then + write (env%unit, '(/,3x,a)') "--------------------------------------" + write (env%unit, '(3x,a)') "--- external electric field / a.u. ---" + write (env%unit, '(3x,3(a,f8.4))') "x = ", set%efield(1), " y = ", set%efield(2), " z = ", set%efield(3) + write (env%unit, '(3x,a)') "--------------------------------------" + end if + + !> initialize metadynamics + call load_metadynamic(metaset, mol%n, mol%at, mol%xyz) + + !> restraining potential + if (allocated(potset%xyz)) then + if (lconstr_all_bonds) call constrain_all_bonds(mol%n, mol%at, potset%xyz) + if (lconstr_all_angles) call constrain_all_angles(mol%n, mol%at, potset%xyz) + if (lconstr_all_torsions) call constrain_all_torsions(mol%n, mol%at, potset%xyz) + call setup_constrain_pot(mol%n, mol%at, potset%xyz) + else + if (lconstr_all_bonds) call constrain_all_bonds(mol%n, mol%at, mol%xyz) + if (lconstr_all_angles) call constrain_all_angles(mol%n, mol%at, mol%xyz) + if (lconstr_all_torsions) call constrain_all_torsions(mol%n, mol%at, mol%xyz) + call setup_constrain_pot(mol%n, mol%at, mol%xyz) + end if + ! fragmentation for CMA constrain + if (iatf1 .eq. 0 .and. iatf2 .eq. 0) then + call ncoord_erf(mol%n, mol%at, mol%xyz, cn) + call splitm(mol%n, mol%at, mol%xyz, cn) + end if + call splitprint(mol%n, mol%at, mol%xyz) + + if (set%verbose) then + call fix_info(env%unit, mol%n, mol%at, mol%xyz) + call pot_info(env%unit, mol%n, mol%at, mol%xyz) + end if + + ! ------------------------------------------------------------------------ + !> write copy of detailed input + if (copycontrol) then + call open_set(ictrl, xcontrol) + call write_set(ictrl) + call close_set(ictrl) + end if + + ! ------------------------------------------------------------------------ + !> if you have requested a define we stop here... + if (set%define) then + if (set%verbose) call main_geometry(env%unit, mol) + call eval_define(set%veryverbose) + end if + call env%show('Please study the warnings concerning your input carefully') + call raise('F', 'Please study the warnings concerning your input carefully') + + ! ======================================================================== + !> From here we switch to the method setup + !> enable error on warnings + if (strict) call mctc_strict + env%strict = strict + + !> one last check on the input geometry + call check_cold_fusion(env, mol, cold_fusion) + if (cold_fusion) then + call env%error("XTB REFUSES TO CONTINUE WITH THIS CALCULATION!") + call env%terminate("Some atoms in the start geometry are *very* close") + end if + + !> check if someone is still using GFN3... + if (set%gfn_method .eq. 3) then + call env%terminate('Wait for some months - for now, please use gfn_method=2!') + end if + + ! ------------------------------------------------------------------------ + !> Print the method header and select the parameter file + + if ((.not. allocated(fnv)) .and. (.not. set%mode_extrun .eq. p_ext_ptb)) then + select case (set%runtyp) + case default + call env%terminate('This is an internal error, please define your runtypes!') + case (p_run_scc, p_run_grad, p_run_opt, p_run_hess, p_run_ohess, p_run_bhess, & + p_run_md, p_run_omd, p_run_path, p_run_screen, & + p_run_modef, p_run_mdopt, p_run_metaopt) + if (set%mode_extrun .eq. p_ext_gfnff) then + fnv = xfind(p_fname_param_gfnff) + ! elseif (set%mode_extrun .eq. p_ext_ptb) then + ! fnv = xfind(p_fname_param_ptb) + else if (set%gfn_method .eq. 0) then fnv = xfind(p_fname_param_gfn0) end if @@ -563,100 +552,111 @@ subroutine xtbMain(env, argParser) if (set%gfn_method .eq. 2) then fnv = xfind(p_fname_param_gfn2) end if - ! if (set%mode_extrun .eq. p_ext_ptb) fnv = xfind(p_fname_param_ptb) - end select - end if - if (set%mode_extrun .eq. p_ext_ptb) then - fnv = "ptb_dummy" - end if - - !------------------------------------------------------------------------- - !> Perform a precomputation of electronic properties for xTB-IFF - if (set%mode_extrun == p_ext_iff) then - allocate (iff_data) - call prepare_IFF(env, mol, iff_data) - call env%checkpoint("Could not generate electronic properties") + end if + case (p_run_vip, p_run_vea, p_run_vipea, p_run_vfukui, p_run_vomega) + if (set%gfn_method .eq. 0) then + fnv = xfind(p_fname_param_gfn0) + end if + if (set%gfn_method .eq. 1) then + fnv = xfind(p_fname_param_gfn1) + end if + if (set%gfn_method .eq. 2) then + fnv = xfind(p_fname_param_gfn2) + end if + ! if (set%mode_extrun .eq. p_ext_ptb) fnv = xfind(p_fname_param_ptb) + end select + end if + if (set%mode_extrun .eq. p_ext_ptb) then + fnv = "ptb_dummy" + end if + + !------------------------------------------------------------------------- + !> Perform a precomputation of electronic properties for xTB-IFF + if (set%mode_extrun == p_ext_iff) then + allocate (iff_data) + call prepare_IFF(env, mol, iff_data) + call env%checkpoint("Could not generate electronic properties") + end if + + ! ------------------------------------------------------------------------ + !> Obtain the parameter data + call newCalculator(env, mol, calc, fnv, restart, set%acc, oniom, iff_data, tblite) + call env%checkpoint("Could not setup single-point calculator") + + call initDefaults(env, calc, mol, gsolvstate) + call env%checkpoint("Could not setup defaults") + + ! ------------------------------------------------------------------------ + !> initial guess, setup wavefunction + select type (calc) + type is (TxTBCalculator) + call chk%wfn%allocate(mol%n, calc%basis%nshell, calc%basis%nao) + + ! Make sure number of electrons is initialized an multiplicity is consistent + chk%wfn%nel = nint(sum(mol%z) - mol%chrg) + chk%wfn%nopen = mol%uhf + if (chk%wfn%nopen == 0 .and. mod(chk%wfn%nel, 2) /= 0) chk%wfn%nopen = 1 + + !> EN charges and CN + if (set%gfn_method .lt. 2) then + call ncoord_d3(mol%n, mol%at, mol%xyz, cn) + else + call ncoord_gfn(mol%n, mol%at, mol%xyz, cn) end if - - ! ------------------------------------------------------------------------ - !> Obtain the parameter data - call newCalculator(env, mol, calc, fnv, restart, set%acc, oniom, iff_data, tblite) - call env%checkpoint("Could not setup single-point calculator") - - call initDefaults(env, calc, mol, gsolvstate) - call env%checkpoint("Could not setup defaults") - - ! ------------------------------------------------------------------------ - !> initial guess, setup wavefunction - select type (calc) - type is (TxTBCalculator) - call chk%wfn%allocate(mol%n, calc%basis%nshell, calc%basis%nao) - - ! Make sure number of electrons is initialized an multiplicity is consistent - chk%wfn%nel = nint(sum(mol%z) - mol%chrg) - chk%wfn%nopen = mol%uhf - if (chk%wfn%nopen == 0 .and. mod(chk%wfn%nel, 2) /= 0) chk%wfn%nopen = 1 - - !> EN charges and CN - if (set%gfn_method .lt. 2) then - call ncoord_d3(mol%n, mol%at, mol%xyz, cn) + if (mol%npbc > 0) then + chk%wfn%q = real(set%ichrg, wp)/real(mol%n, wp) + else + if (set%guess_charges .eq. p_guess_gasteiger) then + call iniqcn(mol%n, mol%at, mol%z, mol%xyz, set%ichrg, 1.0_wp, chk%wfn%q, cn, set%gfn_method, .true.) + else if (set%guess_charges .eq. p_guess_goedecker) then + call ncoord_erf(mol%n, mol%at, mol%xyz, cn) + call goedecker_chrgeq(mol%n, mol%at, mol%xyz, real(set%ichrg, wp), cn, dcn, chk%wfn%q, dq, er, g, & + .false., .false., .false.) else call ncoord_gfn(mol%n, mol%at, mol%xyz, cn) - end if - if (mol%npbc > 0) then chk%wfn%q = real(set%ichrg, wp)/real(mol%n, wp) - else - if (set%guess_charges .eq. p_guess_gasteiger) then - call iniqcn(mol%n, mol%at, mol%z, mol%xyz, set%ichrg, 1.0_wp, chk%wfn%q, cn, set%gfn_method, .true.) - else if (set%guess_charges .eq. p_guess_goedecker) then - call ncoord_erf(mol%n, mol%at, mol%xyz, cn) - call goedecker_chrgeq(mol%n, mol%at, mol%xyz, real(set%ichrg, wp), cn, dcn, chk%wfn%q, dq, er, g, & - .false., .false., .false.) - else - call ncoord_gfn(mol%n, mol%at, mol%xyz, cn) - chk%wfn%q = real(set%ichrg, wp)/real(mol%n, wp) - end if end if - !> initialize shell charges from gasteiger charges - call iniqshell(calc%xtbData, mol%n, mol%at, mol%z, calc%basis%nshell, chk%wfn%q, chk%wfn%qsh, set%gfn_method) - type is (TTBLiteCalculator) - call newTBLiteWavefunction(env, mol, calc, chk) - end select + end if + !> initialize shell charges from gasteiger charges + call iniqshell(calc%xtbData, mol%n, mol%at, mol%z, calc%basis%nshell, chk%wfn%q, chk%wfn%qsh, set%gfn_method) + type is (TTBLiteCalculator) + call newTBLiteWavefunction(env, mol, calc, chk) + end select - ! ------------------------------------------------------------------------ - !> printout a header for the exttyp - call calc%writeInfo(env%unit, mol) + ! ------------------------------------------------------------------------ + !> printout a header for the exttyp + call calc%writeInfo(env%unit, mol) - call delete_file('.sccnotconverged') + call delete_file('.sccnotconverged') - call env%checkpoint("Setup for calculation failed") + call env%checkpoint("Setup for calculation failed") - select type (calc) + select type (calc) + type is (TxTBCalculator) + if (restart .and. calc%xtbData%level /= 0) then ! only in first run + call readRestart(env, chk%wfn, 'xtbrestart', mol%n, mol%at, set%gfn_method, exist, .true.) + end if + calc%etemp = set%etemp + calc%maxiter = set%maxscciter + ipeashift = calc%xtbData%ipeashift + type is (TTBLiteCalculator) + if (restart) then + call loadRestart(env, chk, 'xtbrestart', exist) + if (exist) write (env%unit, "(a)") "Wavefunction read from restart file" + end if + type is (TOniomCalculator) + select type (xtb => calc%real_low) type is (TxTBCalculator) - if (restart .and. calc%xtbData%level /= 0) then ! only in first run + call chk%wfn%allocate(mol%n, xtb%basis%nshell, xtb%basis%nao) + call newWavefunction(env, mol, xtb, chk) + !! assigns only partial charges q and shell charges + if (restart) then ! only in first run call readRestart(env, chk%wfn, 'xtbrestart', mol%n, mol%at, set%gfn_method, exist, .true.) end if - calc%etemp = set%etemp - calc%maxiter = set%maxscciter - ipeashift = calc%xtbData%ipeashift - type is (TTBLiteCalculator) - if (restart) then - call loadRestart(env, chk, 'xtbrestart', exist) - if (exist) write (env%unit, "(a)") "Wavefunction read from restart file" - end if - type is (TOniomCalculator) - select type (xtb => calc%real_low) - type is (TxTBCalculator) - call chk%wfn%allocate(mol%n, xtb%basis%nshell, xtb%basis%nao) - call newWavefunction(env, mol, xtb, chk) - !! assigns only partial charges q and shell charges - if (restart) then ! only in first run - call readRestart(env, chk%wfn, 'xtbrestart', mol%n, mol%at, set%gfn_method, exist, .true.) - end if - end select - if (.not. set%oniom_settings%fixed_chrgs) then - set%oniom_settings%innerchrg = calculateCharge(calc, env, mol, chk) - end if + end select + if (.not. set%oniom_settings%fixed_chrgs) then + set%oniom_settings%innerchrg = calculateCharge(calc, env, mol, chk) + end if end select !------------------------------------------------------------------------- @@ -674,62 +674,62 @@ subroutine xtbMain(env, argParser) call terminate(0) end if - ! ======================================================================== - !> the SP energy which is always done - call start_timing(2) - call calc%singlepoint(env, mol, chk, 2, exist, etot, g, sigma, egap, res) - call stop_timing(2) - select type (calc) - type is (TGFFCalculator) - gff_print = .false. - end select - call env%checkpoint("Single point calculation terminated") - - !> write 2d => 3d converted structure - if (struc_conversion_done) then - call generateFileName(tmpname, 'gfnff_convert', extension, mol%ftype) - write (env%unit, '(10x,a,1x,a,/)') & - "converted geometry written to:", tmpname - call open_file(ich, tmpname, 'w') - call writeMolecule(mol, ich, energy=res%e_total, gnorm=res%gnorm) - call close_file(ich) - end if - - ! ======================================================================== - !> determine kopt for bhess including final biased geometry optimization - if (set%runtyp .eq. p_run_bhess) then - call set_metadynamic(metaset, mol%n, mol%at, mol%xyz) - call get_kopt(metaset, env, restart, mol, chk, calc, egap, set%etemp, set%maxscciter, & - & set%optset%maxoptcycle, set%optset%optlev, etot, g, sigma, set%acc) - end if - - ! ------------------------------------------------------------------------ - !> numerical gradient for debugging purposes - if (debug) then - ! generate a warning to keep release versions from calculating numerical gradients - call env%warning('XTB IS CALCULATING NUMERICAL GRADIENTS, RESET DEBUG FOR RELEASE!') - print'(/,"analytical gradient")' - print *, g - allocate (coord(3, mol%n), source=mol%xyz) - allocate (numg(3, mol%n), gdum(3, mol%n), source=0.0_wp) - wf0 = chk - do i = 1, mol%n - do j = 1, 3 - mol%xyz(j, i) = mol%xyz(j, i) + step - chk = wf0 - call calc%singlepoint(env, mol, chk, 0, .true., er, gdum, sdum, egap, res) - mol%xyz(j, i) = mol%xyz(j, i) - 2*step - chk = wf0 - call calc%singlepoint(env, mol, chk, 0, .true., el, gdum, sdum, egap, res) - mol%xyz(j, i) = mol%xyz(j, i) + step - numg(j, i) = step2*(er - el) - end do + ! ======================================================================== + !> the SP energy which is always done + call start_timing(2) + call calc%singlepoint(env, mol, chk, 2, exist, etot, g, sigma, egap, res) + call stop_timing(2) + select type (calc) + type is (TGFFCalculator) + gff_print = .false. + end select + call env%checkpoint("Single point calculation terminated") + + !> write 2d => 3d converted structure + if (struc_conversion_done) then + call generateFileName(tmpname, 'gfnff_convert', extension, mol%ftype) + write (env%unit, '(10x,a,1x,a,/)') & + "converted geometry written to:", tmpname + call open_file(ich, tmpname, 'w') + call writeMolecule(mol, ich, energy=res%e_total, gnorm=res%gnorm) + call close_file(ich) + end if + + ! ======================================================================== + !> determine kopt for bhess including final biased geometry optimization + if (set%runtyp .eq. p_run_bhess) then + call set_metadynamic(metaset, mol%n, mol%at, mol%xyz) + call get_kopt(metaset, env, restart, mol, chk, calc, egap, set%etemp, set%maxscciter, & + & set%optset%maxoptcycle, set%optset%optlev, etot, g, sigma, set%acc) + end if + + ! ------------------------------------------------------------------------ + !> numerical gradient for debugging purposes + if (debug) then + ! generate a warning to keep release versions from calculating numerical gradients + call env%warning('XTB IS CALCULATING NUMERICAL GRADIENTS, RESET DEBUG FOR RELEASE!') + print'(/,"analytical gradient")' + print *, g + allocate (coord(3, mol%n), source=mol%xyz) + allocate (numg(3, mol%n), gdum(3, mol%n), source=0.0_wp) + wf0 = chk + do i = 1, mol%n + do j = 1, 3 + mol%xyz(j, i) = mol%xyz(j, i) + step + chk = wf0 + call calc%singlepoint(env, mol, chk, 0, .true., er, gdum, sdum, egap, res) + mol%xyz(j, i) = mol%xyz(j, i) - 2*step + chk = wf0 + call calc%singlepoint(env, mol, chk, 0, .true., el, gdum, sdum, egap, res) + mol%xyz(j, i) = mol%xyz(j, i) + step + numg(j, i) = step2*(er - el) end do - print'(/,"numerical gradient")' - print *, numg - print'(/,"difference gradient")' - print *, g - numg - end if + end do + print'(/,"numerical gradient")' + print *, numg + print'(/,"difference gradient")' + print *, g - numg + end if !---------------------------------------------! ! Geometry optimization(ANCopt,L_ANCopt,FIRE) ! @@ -770,239 +770,239 @@ subroutine xtbMain(env, argParser) endif - ! ------------------------------------------------------------------------ - !> automatic VIP and VEA single point (maybe after optimization) - if (set%runtyp .eq. p_run_vip .or. set%runtyp .eq. p_run_vipea & - & .or. set%runtyp .eq. p_run_vomega) then - call start_timing(2) - call vip_header(env%unit) - mol%chrg = mol%chrg + 1 - chk%wfn%nel = chk%wfn%nel - 1 - if (mod(chk%wfn%nel, 2) .ne. 0) chk%wfn%nopen = 1 - call calc%singlepoint(env, mol, chk, 1, exist, etot2, g, sigma, egap, res) - ip = etot2 - etot - ipeashift - write (env%unit, '(72("-"))') - write (env%unit, '("empirical IP shift (eV):",f10.4)') & - & autoev*ipeashift - write (env%unit, '("delta SCC IP (eV):",f10.4)') autoev*ip - write (env%unit, '(72("-"))') - mol%chrg = mol%chrg - 1 - chk%wfn%nel = chk%wfn%nel + 1 - call stop_timing(2) - end if - - if (set%runtyp .eq. p_run_vea .or. set%runtyp .eq. p_run_vipea & - & .or. set%runtyp .eq. p_run_vomega) then - call start_timing(2) - call vea_header(env%unit) - mol%chrg = mol%chrg - 1 - chk%wfn%nel = chk%wfn%nel + 1 - if (mod(chk%wfn%nel, 2) .ne. 0) chk%wfn%nopen = 1 - call calc%singlepoint(env, mol, chk, 1, exist, etot2, g, sigma, egap, res) - ea = etot - etot2 - ipeashift - write (env%unit, '(72("-"))') - write (env%unit, '("empirical EA shift (eV):",f10.4)') & - & autoev*ipeashift - write (env%unit, '("delta SCC EA (eV):",f10.4)') autoev*ea - write (env%unit, '(72("-"))') - - mol%chrg = mol%chrg + 1 - chk%wfn%nel = chk%wfn%nel - 1 - call stop_timing(2) - end if - - ! ------------------------------------------------------------------------ - !> vomega (electrophilicity) index - if (set%runtyp .eq. p_run_vomega) then - write (env%unit, '(a)') - write (env%unit, '(72("-"))') - write (env%unit, '(a,1x,a)') & - "Calculation of global electrophilicity index", & - "(IP+EA)²/(8·(IP-EA))" - vomega = (ip + ea)**2/(8*(ip - ea)) - write (env%unit, '("Global electrophilicity index (eV):",f10.4)') & - autoev*vomega - write (env%unit, '(72("-"))') - end if + ! ------------------------------------------------------------------------ + !> automatic VIP and VEA single point (maybe after optimization) + if (set%runtyp .eq. p_run_vip .or. set%runtyp .eq. p_run_vipea & + & .or. set%runtyp .eq. p_run_vomega) then + call start_timing(2) + call vip_header(env%unit) + mol%chrg = mol%chrg + 1 + chk%wfn%nel = chk%wfn%nel - 1 + if (mod(chk%wfn%nel, 2) .ne. 0) chk%wfn%nopen = 1 + call calc%singlepoint(env, mol, chk, 1, exist, etot2, g, sigma, egap, res) + ip = etot2 - etot - ipeashift + write (env%unit, '(72("-"))') + write (env%unit, '("empirical IP shift (eV):",f10.4)') & + & autoev*ipeashift + write (env%unit, '("delta SCC IP (eV):",f10.4)') autoev*ip + write (env%unit, '(72("-"))') + mol%chrg = mol%chrg - 1 + chk%wfn%nel = chk%wfn%nel + 1 + call stop_timing(2) + end if - ! ------------------------------------------------------------------------ - !> Fukui Index from Mulliken population analysis - if (set%runtyp .eq. p_run_vfukui) then - allocate (fukui(3, mol%n)) - call vfukui(env, mol, chk, calc, fukui) - end if + if (set%runtyp .eq. p_run_vea .or. set%runtyp .eq. p_run_vipea & + & .or. set%runtyp .eq. p_run_vomega) then + call start_timing(2) + call vea_header(env%unit) + mol%chrg = mol%chrg - 1 + chk%wfn%nel = chk%wfn%nel + 1 + if (mod(chk%wfn%nel, 2) .ne. 0) chk%wfn%nopen = 1 + call calc%singlepoint(env, mol, chk, 1, exist, etot2, g, sigma, egap, res) + ea = etot - etot2 - ipeashift + write (env%unit, '(72("-"))') + write (env%unit, '("empirical EA shift (eV):",f10.4)') & + & autoev*ipeashift + write (env%unit, '("delta SCC EA (eV):",f10.4)') autoev*ea + write (env%unit, '(72("-"))') - ! ------------------------------------------------------------------------ - !> numerical hessian calculation - if ((set%runtyp .eq. p_run_hess) .or. (set%runtyp .eq. p_run_ohess) .or. (set%runtyp .eq. p_run_bhess)) then - if (set%runtyp .eq. p_run_bhess .and. set%mode_extrun .ne. p_ext_turbomole) then - call generic_header(env%unit, "Biased Numerical Hessian", 49, 10) - else if (set%runtyp .eq. p_run_bhess .and. set%mode_extrun .eq. p_ext_turbomole) then - call generic_header(env%unit, "Biased Analytical TM Hessian", 49, 10) - else if (set%mode_extrun .eq. p_ext_turbomole) then - call generic_header(env%unit, "Analytical TM Hessian", 49, 10) - else - call numhess_header(env%unit) - end if - if (mol%npbc > 0) then - call env%error("Phonon calculations under PBC are not implemented", source) - end if - call start_timing(5) - call numhess & - & (env, mol, chk, calc, & - & egap, set%etemp, set%maxscciter, etot, g, sigma, fres) - call stop_timing(5) + mol%chrg = mol%chrg + 1 + chk%wfn%nel = chk%wfn%nel - 1 + call stop_timing(2) + end if - call env%checkpoint("Hessian calculation terminated") + ! ------------------------------------------------------------------------ + !> vomega (electrophilicity) index + if (set%runtyp .eq. p_run_vomega) then + write (env%unit, '(a)') + write (env%unit, '(72("-"))') + write (env%unit, '(a,1x,a)') & + "Calculation of global electrophilicity index", & + "(IP+EA)²/(8·(IP-EA))" + vomega = (ip + ea)**2/(8*(ip - ea)) + write (env%unit, '("Global electrophilicity index (eV):",f10.4)') & + autoev*vomega + write (env%unit, '(72("-"))') + end if + + ! ------------------------------------------------------------------------ + !> Fukui Index from Mulliken population analysis + if (set%runtyp .eq. p_run_vfukui) then + allocate (fukui(3, mol%n)) + call vfukui(env, mol, chk, calc, fukui) + end if + + ! ------------------------------------------------------------------------ + !> numerical hessian calculation + if ((set%runtyp .eq. p_run_hess) .or. (set%runtyp .eq. p_run_ohess) .or. (set%runtyp .eq. p_run_bhess)) then + if (set%runtyp .eq. p_run_bhess .and. set%mode_extrun .ne. p_ext_turbomole) then + call generic_header(env%unit, "Biased Numerical Hessian", 49, 10) + else if (set%runtyp .eq. p_run_bhess .and. set%mode_extrun .eq. p_ext_turbomole) then + call generic_header(env%unit, "Biased Analytical TM Hessian", 49, 10) + else if (set%mode_extrun .eq. p_ext_turbomole) then + call generic_header(env%unit, "Analytical TM Hessian", 49, 10) + else + call numhess_header(env%unit) end if - - ! reset the gap, since it is currently not updated in ancopt and numhess - if (allocated(chk%wfn%emo)) then - res%hl_gap = chk%wfn%emo(chk%wfn%ihomo + 1) - chk%wfn%emo(chk%wfn%ihomo) + if (mol%npbc > 0) then + call env%error("Phonon calculations under PBC are not implemented", source) end if - - !> CPCM-X post-SCF solvation - if (allocated(calc%solvation)) then - if (allocated(calc%solvation%cpxsolvent)) then - select type (calc) - type is (TxTBCalculator) - call generic_header(env%unit, "CPCM-X post-SCF solvation evaluation", 49, 10) - if (set%gfn_method .ne. 2) call env%warning("CPCM-X was parametrized for GFN2-xTB. & - &The results are probably inaccurate with other methods.") - Call cpx%setup(env, calc%solvation%cpxsolvent) - Call env%checkpoint("CPCM-X setup terminated") - cpxcalc = calc - deallocate (cpxcalc%solvation) - call cpxcalc%singlepoint(env, mol, chk, 1, .false., energy_gas, g, sigma, egap, res) - Call cpx%calc_solv(env, calc%solvation%cpxsolvent, energy_gas, 0.4_wp, 298.15_wp, 500, 0.0001_wp, res%e_total) - Call cpx%print(set%verbose) - Call env%checkpoint("CPCM-X post-SCF solvation evaluation terminated") - type is (TGFFCalculator) - call env%error("CPCM-X is not possible with a force field.", source) - end select - end if + call start_timing(5) + call numhess & + & (env, mol, chk, calc, & + & egap, set%etemp, set%maxscciter, etot, g, sigma, fres) + call stop_timing(5) + + call env%checkpoint("Hessian calculation terminated") + end if + + ! reset the gap, since it is currently not updated in ancopt and numhess + if (allocated(chk%wfn%emo)) then + res%hl_gap = chk%wfn%emo(chk%wfn%ihomo + 1) - chk%wfn%emo(chk%wfn%ihomo) + end if + + !> CPCM-X post-SCF solvation + if (allocated(calc%solvation)) then + if (allocated(calc%solvation%cpxsolvent)) then + select type (calc) + type is (TxTBCalculator) + call generic_header(env%unit, "CPCM-X post-SCF solvation evaluation", 49, 10) + if (set%gfn_method .ne. 2) call env%warning("CPCM-X was parametrized for GFN2-xTB. & + &The results are probably inaccurate with other methods.") + Call cpx%setup(env, calc%solvation%cpxsolvent) + Call env%checkpoint("CPCM-X setup terminated") + cpxcalc = calc + deallocate (cpxcalc%solvation) + call cpxcalc%singlepoint(env, mol, chk, 1, .false., energy_gas, g, sigma, egap, res) + Call cpx%calc_solv(env, calc%solvation%cpxsolvent, energy_gas, 0.4_wp, 298.15_wp, 500, 0.0001_wp, res%e_total) + Call cpx%print(set%verbose) + Call env%checkpoint("CPCM-X post-SCF solvation evaluation terminated") + type is (TGFFCalculator) + call env%error("CPCM-X is not possible with a force field.", source) + end select end if + end if - call env%checkpoint("Calculation terminated") + call env%checkpoint("Calculation terminated") - ! ======================================================================== - !> PRINTOUT SECTION - if (allocated(set%property_file)) then - call open_file(iprop, set%property_file, 'w') - if (iprop .eq. -1) then - iprop = env%unit - deallocate (set%property_file) - else - write (env%unit, '(/,a)') "Property printout bound to '"//set%property_file//"'" - if (allocated(cdum)) deallocate (cdum) - call get_command(length=l) - allocate (character(len=l) :: cdum) - call get_command(cdum) - write (iprop, '("command: ''",a,"''")') cdum - call rdvar('HOSTNAME', cdum, err) - if (err .eq. 0) & - write (iprop, '("hostname: ''",a,"''")') cdum - write (iprop, '("date: ",a)') prtimestring('S') - end if - else + ! ======================================================================== + !> PRINTOUT SECTION + if (allocated(set%property_file)) then + call open_file(iprop, set%property_file, 'w') + if (iprop .eq. -1) then iprop = env%unit + deallocate (set%property_file) + else + write (env%unit, '(/,a)') "Property printout bound to '"//set%property_file//"'" + if (allocated(cdum)) deallocate (cdum) + call get_command(length=l) + allocate (character(len=l) :: cdum) + call get_command(cdum) + write (iprop, '("command: ''",a,"''")') cdum + call rdvar('HOSTNAME', cdum, err) + if (err .eq. 0) & + write (iprop, '("hostname: ''",a,"''")') cdum + write (iprop, '("date: ",a)') prtimestring('S') end if - - call generic_header(iprop, 'Property Printout', 49, 10) - if (lgrad) then - call writeResultsTurbomole(mol, energy=etot, gradient=g, sigma=sigma) - if (allocated(basename)) then - cdum = basename//'.engrad' - else - cdum = 'xtb-orca.engrad' - end if - call open_file(ich, cdum, 'w') - call writeResultsOrca(ich, mol, etot, g) - call close_file(ich) - end if - if (mol%ftype .eq. fileType%gaussian) then - if (allocated(basename)) then - cdum = basename//'.EOu' - else - cdum = 'xtb-gaussian.EOu' - end if - call open_file(ich, cdum, 'w') - call writeResultsGaussianExternal(ich, etot, res%dipole, g) - call close_file(ich) + else + iprop = env%unit + end if + + call generic_header(iprop, 'Property Printout', 49, 10) + if (lgrad) then + call writeResultsTurbomole(mol, energy=etot, gradient=g, sigma=sigma) + if (allocated(basename)) then + cdum = basename//'.engrad' + else + cdum = 'xtb-orca.engrad' end if - - if (set%periodic) then - write (*, *) 'Periodic properties' + call open_file(ich, cdum, 'w') + call writeResultsOrca(ich, mol, etot, g) + call close_file(ich) + end if + if (mol%ftype .eq. fileType%gaussian) then + if (allocated(basename)) then + cdum = basename//'.EOu' else - select type (calc) - type is (TxTBCalculator) - call main_property(iprop, env, mol, chk%wfn, calc%basis, calc%xtbData, res, & - & calc%solvation, set%acc) - call main_cube(set%verbose, mol, chk%wfn, calc%basis, res) - type is (TGFFCalculator) - call gfnff_property(iprop, mol%n, mol%xyz, calc%topo, chk%nlist) - type is (TPTBCalculator) + cdum = 'xtb-gaussian.EOu' + end if + call open_file(ich, cdum, 'w') + call writeResultsGaussianExternal(ich, etot, res%dipole, g) + call close_file(ich) + end if + + if (set%periodic) then + write (*, *) 'Periodic properties' + else + select type (calc) + type is (TxTBCalculator) + call main_property(iprop, env, mol, chk%wfn, calc%basis, calc%xtbData, res, & + & calc%solvation, set%acc) + call main_cube(set%verbose, mol, chk%wfn, calc%basis, res) + type is (TGFFCalculator) + call gfnff_property(iprop, mol%n, mol%xyz, calc%topo, chk%nlist) + type is (TPTBCalculator) #if WITH_TBLITE - call ptb_property(iprop, env, chk%tblite, calc%bas, mol, chk%wfn, res) + call ptb_property(iprop, env, chk%tblite, calc%bas, mol, chk%wfn, res) #else - call ptb_feature_not_implemented(env) + call ptb_feature_not_implemented(env) #endif - end select - end if + end select + end if - if (set%pr_json) then - select type (calc) - type is (TxTBCalculator) - call open_file(ich, 'xtbout.json', 'w') - call main_xtb_json(ich, & - mol, chk%wfn, calc%basis, res, fres) - call close_file(ich) - type is (TPTBCalculator) + if (set%pr_json) then + select type (calc) + type is (TxTBCalculator) + call open_file(ich, 'xtbout.json', 'w') + call main_xtb_json(ich, & + mol, chk%wfn, calc%basis, res, fres) + call close_file(ich) + type is (TPTBCalculator) #if WITH_TBLITE - call open_file(ich, 'xtbout.json', 'w') - call main_ptb_json(ich, & - mol, chk%wfn, calc%bas, res, fres) - call close_file(ich) + call open_file(ich, 'xtbout.json', 'w') + call main_ptb_json(ich, & + mol, chk%wfn, calc%bas, res, fres) + call close_file(ich) #else - call ptb_feature_not_implemented(env) + call ptb_feature_not_implemented(env) #endif - end select - end if - if (printTopo%any()) then - select type (calc) - type is (TGFFCalculator) - call write_json_gfnff_lists(mol%n, res%e_total, res%gnorm, calc%topo, chk%nlist, printTopo) - end select - end if - if ((set%runtyp .eq. p_run_opt) .or. (set%runtyp .eq. p_run_ohess) .or. & - (set%runtyp .eq. p_run_omd) .or. (set%runtyp .eq. p_run_screen) .or. & - (set%runtyp .eq. p_run_metaopt) .or. (set%runtyp .eq. p_run_bhess)) then - call main_geometry(iprop, mol) - end if - - if ((set%runtyp .eq. p_run_hess) .or. (set%runtyp .eq. p_run_ohess) .or. (set%runtyp .eq. p_run_bhess)) then - call generic_header(iprop, 'Frequency Printout', 49, 10) - call main_freq(iprop, mol, chk%wfn, fres) - end if - - if (allocated(set%property_file)) then - if (iprop .ne. -1 .and. iprop .ne. env%unit) then - call write_energy(iprop, res, fres, & - & (set%runtyp .eq. p_run_hess) .or. (set%runtyp .eq. p_run_ohess) .or. (set%runtyp .eq. p_run_bhess)) - call close_file(iprop) - end if - end if - - if ((set%runtyp .eq. p_run_opt) .or. (set%runtyp .eq. p_run_ohess) .or. & - (set%runtyp .eq. p_run_omd) .or. (set%runtyp .eq. p_run_screen) .or. & - (set%runtyp .eq. p_run_metaopt) .or. (set%runtyp .eq. p_run_bhess)) then - call generateFileName(tmpname, 'xtbopt', extension, mol%ftype) - write (env%unit, '(/,a,1x,a,/)') & - "optimized geometry written to:", tmpname - call open_file(ich, tmpname, 'w') - call writeMolecule(mol, ich, energy=res%e_total, gnorm=res%gnorm) - call close_file(ich) + end select + end if + if (printTopo%any()) then + select type (calc) + type is (TGFFCalculator) + call write_json_gfnff_lists(mol%n, res%e_total, res%gnorm, calc%topo, chk%nlist, printTopo) + end select + end if + if ((set%runtyp .eq. p_run_opt) .or. (set%runtyp .eq. p_run_ohess) .or. & + (set%runtyp .eq. p_run_omd) .or. (set%runtyp .eq. p_run_screen) .or. & + (set%runtyp .eq. p_run_metaopt) .or. (set%runtyp .eq. p_run_bhess)) then + call main_geometry(iprop, mol) + end if + + if ((set%runtyp .eq. p_run_hess) .or. (set%runtyp .eq. p_run_ohess) .or. (set%runtyp .eq. p_run_bhess)) then + call generic_header(iprop, 'Frequency Printout', 49, 10) + call main_freq(iprop, mol, chk%wfn, fres) + end if + + if (allocated(set%property_file)) then + if (iprop .ne. -1 .and. iprop .ne. env%unit) then + call write_energy(iprop, res, fres, & + & (set%runtyp .eq. p_run_hess) .or. (set%runtyp .eq. p_run_ohess) .or. (set%runtyp .eq. p_run_bhess)) + call close_file(iprop) end if + end if + + if ((set%runtyp .eq. p_run_opt) .or. (set%runtyp .eq. p_run_ohess) .or. & + (set%runtyp .eq. p_run_omd) .or. (set%runtyp .eq. p_run_screen) .or. & + (set%runtyp .eq. p_run_metaopt) .or. (set%runtyp .eq. p_run_bhess)) then + call generateFileName(tmpname, 'xtbopt', extension, mol%ftype) + write (env%unit, '(/,a,1x,a,/)') & + "optimized geometry written to:", tmpname + call open_file(ich, tmpname, 'w') + call writeMolecule(mol, ich, energy=res%e_total, gnorm=res%gnorm) + call close_file(ich) + end if select type (calc) type is (TxTBCalculator) @@ -1018,304 +1018,304 @@ subroutine xtbMain(env, argParser) end select - ! ------------------------------------------------------------------------ - ! xtb molecular dynamics - if ((set%runtyp .eq. p_run_md) .or. (set%runtyp .eq. p_run_omd)) then - if (metaset%maxsave .gt. 0) then - if (mol%npbc > 0) then - call env%error("Metadynamic under PBC is not implemented", source) - end if - call metadyn_header(env%unit) - else - call md_header(env%unit) - end if - fixset%n = 0 ! no fixing for MD runs - call start_timing(6) - idum = 0 - select type (calc) - class default - if (set%shake_md) call init_shake(mol%n, mol%at, mol%xyz, chk%wfn%wbo) - type is (TGFFCalculator) - if (set%shake_md) call gff_init_shake(mol%n, mol%at, mol%xyz, calc%topo) - end select - call md & - & (env, mol, chk, calc, & - & egap, set%etemp, set%maxscciter, etot, g, sigma, 0, set%temp_md, idum) - call stop_timing(6) - end if - - ! ------------------------------------------------------------------------ - ! metadynamics - if (set%runtyp .eq. p_run_metaopt) then + ! ------------------------------------------------------------------------ + ! xtb molecular dynamics + if ((set%runtyp .eq. p_run_md) .or. (set%runtyp .eq. p_run_omd)) then + if (metaset%maxsave .gt. 0) then if (mol%npbc > 0) then - call env%warning("Metadynamic under PBC is not implemented", source) + call env%error("Metadynamic under PBC is not implemented", source) end if call metadyn_header(env%unit) - ! check if ANCOPT already convered - if (murks) then - call env%error('Optimization did not converge, aborting', source) - end if - write (env%unit, '(1x,"output written to xtbmeta.log")') - call open_file(ich, 'xtbmeta.log', 'w') - call writeMolecule(mol, ich, fileType%xyz, energy=etot, gnorm=norm2(g)) - k = metaset%nstruc + 1 - call start_timing(6) - do l = k, metaset%maxsave - metaset%nstruc = l - metaset%xyz(:, :, metaset%nstruc) = mol%xyz - ! randomize structure to avoid zero RMSD - do i = 1, mol%n - do j = 1, 3 - call random_number(er) - mol%xyz(j, i) = mol%xyz(j, i) + 1.0e-6_wp*er - end do - end do - call geometry_optimization & - & (env, mol, chk, calc, & - & egap, set%etemp, set%maxscciter, set%optset%maxoptcycle, etot, g, sigma, & - & set%optset%optlev, set%verbose, .true., murks) - if (.not. set%verbose) then - write (env%unit, '("current energy:",1x,f20.8)') etot - end if - if (murks) then - call close_file(ich) - write (env%unit, '(/,3x,"***",1x,a,1x,"***",/)') & - "FAILED TO CONVERGE GEOMETRY OPTIMIZATION" - call touch_file('NOT_CONVERGED') - end if - call writeMolecule(mol, ich, fileType%xyz, energy=etot, gnorm=norm2(g)) - end do - call close_file(ich) - call stop_timing(6) - end if - - ! ------------------------------------------------------------------------ - ! path finder - if (set%runtyp .eq. p_run_path) then - call rmsdpath_header(env%unit) - if (mol%npbc > 0) then - call env%warning("Metadynamics under PBC are not implemented", source) - end if - call start_timing(4) - call bias_path(env, mol, chk, calc, egap, set%etemp, set%maxscciter, etot, g, sigma) - call stop_timing(4) - end if - - ! ------------------------------------------------------------------------ - ! screen over input structures - if (set%runtyp .eq. p_run_screen) then - call start_timing(8) - call screen(env, mol, chk, calc, egap, set%etemp, set%maxscciter, etot, g, sigma) - call stop_timing(8) - end if - - ! ------------------------------------------------------------------------ - ! mode following for conformer search - if (set%runtyp .eq. p_run_modef) then - if (mol%npbc > 0) then - call env%warning("Modefollowing under PBC is not implemented", source) - end if - call start_timing(9) - call modefollow(env, mol, chk, calc, egap, set%etemp, set%maxscciter, etot, g, sigma) - call stop_timing(9) - end if - - ! ------------------------------------------------------------------------ - ! optimize along MD from xtb.trj for conformer searches - if (set%runtyp .eq. p_run_mdopt) then - call start_timing(10) - call mdopt(env, mol, chk, calc, egap, set%etemp, set%maxscciter, etot, g, sigma) - call stop_timing(10) + else + call md_header(env%unit) end if - - ! ------------------------------------------------------------------------ - ! to further speed up xtb calculations we dump our most important - ! quantities in a restart file, so we can save some precious seconds + fixset%n = 0 ! no fixing for MD runs + call start_timing(6) + idum = 0 select type (calc) - type is (TxTBCalculator) - if (restart) then - call writeRestart(env, chk%wfn, 'xtbrestart', set%gfn_method) - end if - type is (TTBLiteCalculator) - if (restart) call dumpRestart(env, chk, 'xtbrestart') + class default + if (set%shake_md) call init_shake(mol%n, mol%at, mol%xyz, chk%wfn%wbo) + type is (TGFFCalculator) + if (set%shake_md) call gff_init_shake(mol%n, mol%at, mol%xyz, calc%topo) end select - - ! ------------------------------------------------------------------------ - ! we may have generated some non-fatal errors, which have been saved, - ! so we should tell the user, (s)he may want to know what went wrong - call env%show("Runtime exception occurred") - call raise('F', 'Some non-fatal runtime exceptions were caught,'// & - & ' please check:') - - ! ------------------------------------------------------------------------ - ! print all files xtb interacted with while running (for debugging mainly) - if (set%verbose) then - write (env%unit, '(a)') - write (env%unit, '(72("-"))') - call print_filelist(env%unit) - end if - - ! ------------------------------------------------------------------------ - ! make some post processing afterward, show some timings and stuff - write (env%unit, '(a)') - write (env%unit, '(72("-"))') - call stop_timing_run - call stop_timing(1) - call prdate('E') - write (env%unit, '(72("-"))') - call prtiming(1, 'total') - call prtiming(2, 'SCF') - if ((set%runtyp .eq. p_run_opt) .or. (set%runtyp .eq. p_run_ohess) .or. & - & (set%runtyp .eq. p_run_omd) .or. (set%runtyp .eq. p_run_metaopt)) then - call prtiming(3, 'ANC optimizer') + call md & + & (env, mol, chk, calc, & + & egap, set%etemp, set%maxscciter, etot, g, sigma, 0, set%temp_md, idum) + call stop_timing(6) + end if + + ! ------------------------------------------------------------------------ + ! metadynamics + if (set%runtyp .eq. p_run_metaopt) then + if (mol%npbc > 0) then + call env%warning("Metadynamic under PBC is not implemented", source) end if - if (set%runtyp .eq. p_run_path) then - call prtiming(4, 'path finder') + call metadyn_header(env%unit) + ! check if ANCOPT already convered + if (murks) then + call env%error('Optimization did not converge, aborting', source) end if - if (((set%runtyp .eq. p_run_hess) .or. (set%runtyp .eq. p_run_ohess) .or. (set%runtyp .eq. p_run_bhess))) then - if (set%mode_extrun .ne. p_ext_turbomole) then - call prtiming(5, 'analytical hessian') - else - call prtiming(5, 'numerical hessian') + write (env%unit, '(1x,"output written to xtbmeta.log")') + call open_file(ich, 'xtbmeta.log', 'w') + call writeMolecule(mol, ich, fileType%xyz, energy=etot, gnorm=norm2(g)) + k = metaset%nstruc + 1 + call start_timing(6) + do l = k, metaset%maxsave + metaset%nstruc = l + metaset%xyz(:, :, metaset%nstruc) = mol%xyz + ! randomize structure to avoid zero RMSD + do i = 1, mol%n + do j = 1, 3 + call random_number(er) + mol%xyz(j, i) = mol%xyz(j, i) + 1.0e-6_wp*er + end do + end do + call geometry_optimization & + & (env, mol, chk, calc, & + & egap, set%etemp, set%maxscciter, set%optset%maxoptcycle, etot, g, sigma, & + & set%optset%optlev, set%verbose, .true., murks) + if (.not. set%verbose) then + write (env%unit, '("current energy:",1x,f20.8)') etot end if + if (murks) then + call close_file(ich) + write (env%unit, '(/,3x,"***",1x,a,1x,"***",/)') & + "FAILED TO CONVERGE GEOMETRY OPTIMIZATION" + call touch_file('NOT_CONVERGED') + end if + call writeMolecule(mol, ich, fileType%xyz, energy=etot, gnorm=norm2(g)) + end do + call close_file(ich) + call stop_timing(6) + end if + + ! ------------------------------------------------------------------------ + ! path finder + if (set%runtyp .eq. p_run_path) then + call rmsdpath_header(env%unit) + if (mol%npbc > 0) then + call env%warning("Metadynamics under PBC are not implemented", source) end if - if ((set%runtyp .eq. p_run_md) .or. (set%runtyp .eq. p_run_omd) .or. & - (set%runtyp .eq. p_run_metaopt)) then - call prtiming(6, 'MD') - end if - if (set%runtyp .eq. p_run_screen) then - call prtiming(8, 'screen') - end if - if (set%runtyp .eq. p_run_modef) then - call prtiming(9, 'mode following') + call start_timing(4) + call bias_path(env, mol, chk, calc, egap, set%etemp, set%maxscciter, etot, g, sigma) + call stop_timing(4) + end if + + ! ------------------------------------------------------------------------ + ! screen over input structures + if (set%runtyp .eq. p_run_screen) then + call start_timing(8) + call screen(env, mol, chk, calc, egap, set%etemp, set%maxscciter, etot, g, sigma) + call stop_timing(8) + end if + + ! ------------------------------------------------------------------------ + ! mode following for conformer search + if (set%runtyp .eq. p_run_modef) then + if (mol%npbc > 0) then + call env%warning("Modefollowing under PBC is not implemented", source) end if - if (set%runtyp .eq. p_run_mdopt) then - call prtiming(10, 'MD opt.') + call start_timing(9) + call modefollow(env, mol, chk, calc, egap, set%etemp, set%maxscciter, etot, g, sigma) + call stop_timing(9) + end if + + ! ------------------------------------------------------------------------ + ! optimize along MD from xtb.trj for conformer searches + if (set%runtyp .eq. p_run_mdopt) then + call start_timing(10) + call mdopt(env, mol, chk, calc, egap, set%etemp, set%maxscciter, etot, g, sigma) + call stop_timing(10) + end if + + ! ------------------------------------------------------------------------ + ! to further speed up xtb calculations we dump our most important + ! quantities in a restart file, so we can save some precious seconds + select type (calc) + type is (TxTBCalculator) + if (restart) then + call writeRestart(env, chk%wfn, 'xtbrestart', set%gfn_method) end if - + type is (TTBLiteCalculator) + if (restart) call dumpRestart(env, chk, 'xtbrestart') + end select + + ! ------------------------------------------------------------------------ + ! we may have generated some non-fatal errors, which have been saved, + ! so we should tell the user, (s)he may want to know what went wrong + call env%show("Runtime exception occurred") + call raise('F', 'Some non-fatal runtime exceptions were caught,'// & + & ' please check:') + + ! ------------------------------------------------------------------------ + ! print all files xtb interacted with while running (for debugging mainly) + if (set%verbose) then write (env%unit, '(a)') - call terminate(0) - - end subroutine xtbMain + write (env%unit, '(72("-"))') + call print_filelist(env%unit) + end if + + ! ------------------------------------------------------------------------ + ! make some post processing afterward, show some timings and stuff + write (env%unit, '(a)') + write (env%unit, '(72("-"))') + call stop_timing_run + call stop_timing(1) + call prdate('E') + write (env%unit, '(72("-"))') + call prtiming(1, 'total') + call prtiming(2, 'SCF') + if ((set%runtyp .eq. p_run_opt) .or. (set%runtyp .eq. p_run_ohess) .or. & + & (set%runtyp .eq. p_run_omd) .or. (set%runtyp .eq. p_run_metaopt)) then + call prtiming(3, 'ANC optimizer') + end if + if (set%runtyp .eq. p_run_path) then + call prtiming(4, 'path finder') + end if + if (((set%runtyp .eq. p_run_hess) .or. (set%runtyp .eq. p_run_ohess) .or. (set%runtyp .eq. p_run_bhess))) then + if (set%mode_extrun .ne. p_ext_turbomole) then + call prtiming(5, 'analytical hessian') + else + call prtiming(5, 'numerical hessian') + end if + end if + if ((set%runtyp .eq. p_run_md) .or. (set%runtyp .eq. p_run_omd) .or. & + (set%runtyp .eq. p_run_metaopt)) then + call prtiming(6, 'MD') + end if + if (set%runtyp .eq. p_run_screen) then + call prtiming(8, 'screen') + end if + if (set%runtyp .eq. p_run_modef) then + call prtiming(9, 'mode following') + end if + if (set%runtyp .eq. p_run_mdopt) then + call prtiming(10, 'MD opt.') + end if + + write (env%unit, '(a)') + call terminate(0) + +end subroutine xtbMain !> Parse command line arguments and forward them to settings - subroutine parseArguments(env, args, inputFile, paramFile, lgrad, & - & restart, gsolvstate, strict, copycontrol, coffee, printTopo, oniom, dipro, tblite) +subroutine parseArguments(env, args, inputFile, paramFile, lgrad, & + & restart, gsolvstate, strict, copycontrol, coffee, printTopo, oniom, dipro, tblite) - use xtb_mctc_global, only: persistentEnv + use xtb_mctc_global, only: persistentEnv - !> Name of error producer - character(len=*), parameter :: source = "prog_main_parseArguments" + !> Name of error producer + character(len=*), parameter :: source = "prog_main_parseArguments" - !> Calculation environment - type(TEnvironment) :: env + !> Calculation environment + type(TEnvironment) :: env - !> Command line argument parser - type(TArgParser) :: args + !> Command line argument parser + type(TArgParser) :: args - !> Detailed input file name - character(len=:), allocatable, intent(out) :: inputFile + !> Detailed input file name + character(len=:), allocatable, intent(out) :: inputFile - !> Parameter file name - character(len=:), allocatable, intent(out) :: paramFile + !> Parameter file name + character(len=:), allocatable, intent(out) :: paramFile - !> Reference state for solvation free energies - integer, intent(out) :: gsolvstate + !> Reference state for solvation free energies + integer, intent(out) :: gsolvstate - !> Restart calculation - logical, intent(out) :: restart + !> Restart calculation + logical, intent(out) :: restart - !> Handle warnings as errors - logical, intent(out) :: strict + !> Handle warnings as errors + logical, intent(out) :: strict - !> Debugging with a lot of caffeine - logical, intent(out) :: coffee + !> Debugging with a lot of caffeine + logical, intent(out) :: coffee - !> topology printout list - type(TPrintTopo), intent(out) :: printTopo + !> topology printout list + type(TPrintTopo), intent(out) :: printTopo - !> Print the gradient to file - logical, intent(out) :: lgrad + !> Print the gradient to file + logical, intent(out) :: lgrad - !> Copy the detailed input file - logical, intent(out) :: copycontrol + !> Copy the detailed input file + logical, intent(out) :: copycontrol - !> Input for ONIOM model - type(oniom_input), intent(out) :: oniom + !> Input for ONIOM model + type(oniom_input), intent(out) :: oniom - !> Input for DIPRO - type(jab_input), intent(inout) :: dipro + !> Input for DIPRO + type(jab_input), intent(inout) :: dipro - !> Stuff for second argument parser + !> Stuff for second argument parser ! integer :: narg ! character(len=p_str_length), dimension(p_arg_length) :: argv ! type(TAtomList) :: atl ! integer, allocatable :: list(:) - !> Input for TBLite calculator - type(TTBLiteInput), intent(out) :: tblite + !> Input for TBLite calculator + type(TTBLiteInput), intent(out) :: tblite !$ integer :: omp_get_num_threads, nproc - integer :: nFlags - integer :: idum, ndum - real(wp) :: ddum - character(len=:), allocatable :: flag, sec - logical :: exist - - set%gfn_method = 2 - dipro%diprocalc = .false. - coffee = .false. - strict = .false. - restart = .true. - copycontrol = .false. - lgrad = .false. - gsolvstate = solutionState%gsolv - tblite%color = get_xtb_feature('color') - - nFlags = args%countFlags() - call args%nextFlag(flag) - do while (allocated(flag)) - if (len(flag) > 2 .and. flag(1:1) == '-' .and. flag(1:2) /= '--') then - call env%warning("the use of '"//flag//"' is discouraged, "// & - & "please use '-"//flag//"' next time", source) - flag = '-'//flag - end if - select case (flag) - case default - call env%warning("Unknown option '"//flag//"' provided", source) + integer :: nFlags + integer :: idum, ndum + real(wp) :: ddum + character(len=:), allocatable :: flag, sec + logical :: exist + + set%gfn_method = 2 + dipro%diprocalc = .false. + coffee = .false. + strict = .false. + restart = .true. + copycontrol = .false. + lgrad = .false. + gsolvstate = solutionState%gsolv + tblite%color = get_xtb_feature('color') + + nFlags = args%countFlags() + call args%nextFlag(flag) + do while (allocated(flag)) + if (len(flag) > 2 .and. flag(1:1) == '-' .and. flag(1:2) /= '--') then + call env%warning("the use of '"//flag//"' is discouraged, "// & + & "please use '-"//flag//"' next time", source) + flag = '-'//flag + end if + select case (flag) + case default + call env%warning("Unknown option '"//flag//"' provided", source) - case ('-h', '--help') - call help(env%unit) - call terminate(0) + case ('-h', '--help') + call help(env%unit) + call terminate(0) - case ('--citation') - call citation(env%unit) - call terminate(0) + case ('--citation') + call citation(env%unit) + call terminate(0) - case ('--license') - call disclamer(env%unit) - call terminate(0) + case ('--license') + call disclamer(env%unit) + call terminate(0) - case ('--version') - call xtb_header(env%unit) - call terminate(0) + case ('--version') + call xtb_header(env%unit) + call terminate(0) - case ('-v', '--verbose') - set%verbose = .true. + case ('-v', '--verbose') + set%verbose = .true. - case ('-V', '--very-verbose') - set%verbose = .true. - set%veryverbose = .true. + case ('-V', '--very-verbose') + set%verbose = .true. + set%veryverbose = .true. - case ('--define') - call set_define + case ('--define') + call set_define - case ('-P', '--parallel') + case ('-P', '--parallel') !$ if (.false.) then - call env%warning('Program compiled without threading support', source) + call env%warning('Program compiled without threading support', source) !$ end if - ! Always remove next argument to keep argument parsing consistent - call args%nextArg(sec) + ! Always remove next argument to keep argument parsing consistent + call args%nextArg(sec) !$ if (allocated(sec)) then !$ if (getValue(env, sec, idum)) then !$ nproc = omp_get_num_threads() @@ -1325,198 +1325,198 @@ subroutine parseArguments(env, args, inputFile, paramFile, lgrad, & #endif !$ end if !$ end if - + case ('--restart') - restart = .true. + restart = .true. - case ('--norestart') - restart = .false. + case ('--norestart') + restart = .false. - case ('--copy') - copycontrol = .true. + case ('--copy') + copycontrol = .true. - case ('--nocopy') - copycontrol = .false. + case ('--nocopy') + copycontrol = .false. - case ('--strict') - strict = .true. + case ('--strict') + strict = .true. - case ('-I', '--input') - call args%nextArg(inputFile) - if (.not. allocated(inputFile)) then - call env%error("Filename for detailed input is missing", source) - end if - - case ('--namespace') - call args%nextArg(persistentEnv%io%namespace) - if (.not. allocated(persistentEnv%io%namespace)) then - call env%error("Namespace argument is missing", source) - end if + case ('-I', '--input') + call args%nextArg(inputFile) + if (.not. allocated(inputFile)) then + call env%error("Filename for detailed input is missing", source) + end if - case ('--vparam') - call args%nextArg(paramFile) - if (.not. allocated(paramFile)) then - call env%error("Filename for --vparam is missing", source) - else - tblite%param = paramFile - end if + case ('--namespace') + call args%nextArg(persistentEnv%io%namespace) + if (.not. allocated(persistentEnv%io%namespace)) then + call env%error("Namespace argument is missing", source) + end if - case ('--coffee') - coffee = .true. + case ('--vparam') + call args%nextArg(paramFile) + if (.not. allocated(paramFile)) then + call env%error("Filename for --vparam is missing", source) + else + tblite%param = paramFile + end if - case ('-a', '--acc') - call args%nextArg(sec) - if (allocated(sec)) then - if (getValue(env, sec, ddum)) then - if (ddum .lt. 1.e-4_wp) then - call env%warning("We cannot provide this level of accuracy, "//& - & "resetted accuracy to 0.0001", source) - set%acc = 1.e-4_wp - else if (ddum .gt. 1.e+3_wp) then - call env%warning("We cannot provide this level of accuracy, "//& - & "resetted accuracy to 1000", source) - set%acc = 1.e+3_wp - else - set%acc = ddum - end if + case ('--coffee') + coffee = .true. + + case ('-a', '--acc') + call args%nextArg(sec) + if (allocated(sec)) then + if (getValue(env, sec, ddum)) then + if (ddum .lt. 1.e-4_wp) then + call env%warning("We cannot provide this level of accuracy, "//& + & "resetted accuracy to 0.0001", source) + set%acc = 1.e-4_wp + else if (ddum .gt. 1.e+3_wp) then + call env%warning("We cannot provide this level of accuracy, "//& + & "resetted accuracy to 1000", source) + set%acc = 1.e+3_wp + else + set%acc = ddum end if - tblite%accuracy = set%acc - else - call env%error("Accuracy is not provided", source) end if + tblite%accuracy = set%acc + else + call env%error("Accuracy is not provided", source) + end if - case ('-c', '--chrg', '--charge') - call args%nextArg(sec) - if (allocated(sec)) then - call set_chrg(env, sec) - else - call env%error("Molecular charge is not provided", source) - end if + case ('-c', '--chrg', '--charge') + call args%nextArg(sec) + if (allocated(sec)) then + call set_chrg(env, sec) + else + call env%error("Molecular charge is not provided", source) + end if - case ('-u', '--uhf') - call args%nextArg(sec) - if (allocated(sec)) then - call set_spin(env, sec) - else - call env%error("Number of unpaired electrons is not provided", source) - end if + case ('-u', '--uhf') + call args%nextArg(sec) + if (allocated(sec)) then + call set_spin(env, sec) + else + call env%error("Number of unpaired electrons is not provided", source) + end if - case ("--efield") - call args%nextArg(sec) - if (allocated(sec)) then - call set_efield(env, sec) - else - call env%error("Electric field is not provided", source) - end if + case ("--efield") + call args%nextArg(sec) + if (allocated(sec)) then + call set_efield(env, sec) + else + call env%error("Electric field is not provided", source) + end if - case ('--gfn') - call args%nextArg(sec) - if (allocated(sec)) then - call set_gfn(env, 'method', sec) - if (sec == '0') call set_exttyp('eht') - tblite%method = "gfn"//sec - else - call env%error("No method provided for --gfn option", source) - end if + case ('--gfn') + call args%nextArg(sec) + if (allocated(sec)) then + call set_gfn(env, 'method', sec) + if (sec == '0') call set_exttyp('eht') + tblite%method = "gfn"//sec + else + call env%error("No method provided for --gfn option", source) + end if - case ('--gfn1') - call set_gfn(env, 'method', '1') - call env%warning("The use of '"//flag//"' is discouraged, "//& - & "please use '--gfn 1' next time", source) - tblite%method = "gfn1" + case ('--gfn1') + call set_gfn(env, 'method', '1') + call env%warning("The use of '"//flag//"' is discouraged, "//& + & "please use '--gfn 1' next time", source) + tblite%method = "gfn1" - case ('--gfn2') - call set_gfn(env, 'method', '2') - call set_gfn(env, 'd4', 'true') - tblite%method = "gfn2" + case ('--gfn2') + call set_gfn(env, 'method', '2') + call set_gfn(env, 'd4', 'true') + tblite%method = "gfn2" - case ('--gfn0') - call set_gfn(env, 'method', '0') - call set_exttyp('eht') - call env%warning("The use of '"//flag//"' is discouraged, "//& - & "please use '--gfn 0' next time", source) + case ('--gfn0') + call set_gfn(env, 'method', '0') + call set_exttyp('eht') + call env%warning("The use of '"//flag//"' is discouraged, "//& + & "please use '--gfn 0' next time", source) - case ('--gfnff') - call set_exttyp('ff') + case ('--gfnff') + call set_exttyp('ff') - case ('--gff') - call set_exttyp('ff') + case ('--gff') + call set_exttyp('ff') - case ('--iff') - call set_exttyp('iff') + case ('--iff') + call set_exttyp('iff') - case ('--ptb') - call set_exttyp('ptb') + case ('--ptb') + call set_exttyp('ptb') - case ('--tblite') - if (get_xtb_feature('tblite')) then - call set_exttyp('tblite') - else - call env%error("Compiled without support for tblite library", source) - return - end if + case ('--tblite') + if (get_xtb_feature('tblite')) then + call set_exttyp('tblite') + else + call env%error("Compiled without support for tblite library", source) + return + end if - case ('--color') - if (allocated(sec)) then - select case (sec) - case ('auto') - tblite%color = get_xtb_feature('color') - case ('always') - tblite%color = .true. - case ('never') - tblite%color = .false. - case default - call env%warning("Unknown color option '"//sec//"' provided", source) - end select - else - call env%error("No color scheme provided for --color option", source) - end if + case ('--color') + if (allocated(sec)) then + select case (sec) + case ('auto') + tblite%color = get_xtb_feature('color') + case ('always') + tblite%color = .true. + case ('never') + tblite%color = .false. + case default + call env%warning("Unknown color option '"//sec//"' provided", source) + end select + else + call env%error("No color scheme provided for --color option", source) + end if - case ('--spinpol') - if (get_xtb_feature('tblite')) then - tblite%spin_polarized = .true. - else - call env%error("Compiled without support for tblite library. This is required for spin-polarization", source) - return - end if + case ('--spinpol') + if (get_xtb_feature('tblite')) then + tblite%spin_polarized = .true. + else + call env%error("Compiled without support for tblite library. This is required for spin-polarization", source) + return + end if - case ('--dipro') - if (get_xtb_feature('tblite')) then - dipro%diprocalc = .true. - call set_runtyp('scc') - call args%nextArg(sec) - if (allocated(sec)) then - read (sec, '(f10.3)') dipro%othr - else - dipro%othr = 0.1_wp - end if + case ('--dipro') + if (get_xtb_feature('tblite')) then + dipro%diprocalc = .true. + call set_runtyp('scc') + call args%nextArg(sec) + if (allocated(sec)) then + read (sec, '(f10.3)') dipro%othr else - call env%error("Compiled without support for tblite library. This is required for DIPRO", source) - return + dipro%othr = 0.1_wp end if + else + call env%error("Compiled without support for tblite library. This is required for DIPRO", source) + return + end if - case ('--oniom') - call set_exttyp('oniom') - call args%nextArg(sec) + case ('--oniom') + call set_exttyp('oniom') + call args%nextArg(sec) - if (.not. allocated(sec)) then ! handle no argument case ! - call env%error("No inner region is provided for ONIOM", source) - return - end if - call move_alloc(sec, oniom%first_arg) + if (.not. allocated(sec)) then ! handle no argument case ! + call env%error("No inner region is provided for ONIOM", source) + return + end if + call move_alloc(sec, oniom%first_arg) - call args%nextArg(sec) - if (.not. allocated(sec)) then - call env%warning("No method is specified for ONIOM," & - &//achar(10)//" default gfn2:gfnff combination will be used", source) - call move_alloc(oniom%first_arg, sec) - end if + call args%nextArg(sec) + if (.not. allocated(sec)) then + call env%warning("No method is specified for ONIOM," & + &//achar(10)//" default gfn2:gfnff combination will be used", source) + call move_alloc(oniom%first_arg, sec) + end if - inquire (file=sec, exist=exist) - if (exist) then - sec = read_whole_file(sec) - end if - call move_alloc(sec, oniom%second_arg) + inquire (file=sec, exist=exist) + if (exist) then + sec = read_whole_file(sec) + end if + call move_alloc(sec, oniom%second_arg) case ('--cut') call set_cut @@ -1529,79 +1529,79 @@ subroutine parseArguments(env, args, inputFile, paramFile, lgrad, & call env%error("Temperature in --etemp option is missing", source) end if - case ('--esp') - call set_runtyp('scc') - call set_write(env, 'esp', 'true') + case ('--esp') + call set_runtyp('scc') + call set_write(env, 'esp', 'true') - case ('--stm') - call set_runtyp('scc') - call set_write(env, 'stm', 'true') + case ('--stm') + call set_runtyp('scc') + call set_write(env, 'stm', 'true') - case ('--cma') - call set_cma + case ('--cma') + call set_cma - case ('--tm') - call set_exttyp('turbomole') + case ('--tm') + call set_exttyp('turbomole') - case ('--enso') - call set_enso_mode + case ('--enso') + call set_enso_mode - case ('--json') - call set_write(env, 'json', 'true') - Call setWRtopo("json", printTopo) + case ('--json') + call set_write(env, 'json', 'true') + Call setWRtopo("json", printTopo) - case ('--ceasefiles') - restart = .false. - set%verbose = .false. - set%ceasefiles = .true. - call set_write(env, 'wiberg', 'false') - call set_write(env, 'charges', 'false') + case ('--ceasefiles') + restart = .false. + set%verbose = .false. + set%ceasefiles = .true. + call set_write(env, 'wiberg', 'false') + call set_write(env, 'charges', 'false') #ifdef _WIN32 - call set_opt(env, 'logfile', 'NUL') + call set_opt(env, 'logfile', 'NUL') #else - call set_opt(env, 'logfile', '/dev/null') + call set_opt(env, 'logfile', '/dev/null') #endif - case ('--orca') - call set_exttyp('orca') + case ('--orca') + call set_exttyp('orca') - case ('--driver') - call set_exttyp('driver') - call args%nextArg(sec) - if (allocated(sec)) then - set%ext_driver%executable = sec - end if + case ('--driver') + call set_exttyp('driver') + call args%nextArg(sec) + if (allocated(sec)) then + set%ext_driver%executable = sec + end if - case ('--mopac') - call set_exttyp('mopac') + case ('--mopac') + call set_exttyp('mopac') - case ('--pop') - call set_write(env, 'mulliken', 'true') + case ('--pop') + call set_write(env, 'mulliken', 'true') - case ('--molden') - call set_write(env, 'mos', 'true') + case ('--molden') + call set_write(env, 'mos', 'true') - case ('--dipole') - call set_write(env, 'dipole', 'true') + case ('--dipole') + call set_write(env, 'dipole', 'true') - case ('--wbo') - call set_write(env, 'wiberg', 'true') + case ('--wbo') + call set_write(env, 'wiberg', 'true') - case ('--lmo') - call set_write(env, 'mulliken', 'true') - call set_write(env, 'lmo', 'true') + case ('--lmo') + call set_write(env, 'mulliken', 'true') + call set_write(env, 'lmo', 'true') - case ('--ewin') - call args%nextArg(sec) - if (allocated(sec)) then - call set_siman(env, 'ewin', sec) - else - call env%error("Real argument for --ewin is missing", source) - end if + case ('--ewin') + call args%nextArg(sec) + if (allocated(sec)) then + call set_siman(env, 'ewin', sec) + else + call env%error("Real argument for --ewin is missing", source) + end if - case ('--fod') - call set_write(env, 'fod', 'true') - call set_scc(env, 'temp', '5000.0') + case ('--fod') + call set_write(env, 'fod', 'true') + call set_scc(env, 'temp', '5000.0') case ('--iterations', '--maxiterations') call args%nextArg(sec) @@ -1611,307 +1611,307 @@ subroutine parseArguments(env, args, inputFile, paramFile, lgrad, & call env%error("Integer argument for --iterations is missing", source) end if - case ('--cycles') - call args%nextArg(sec) - if (allocated(sec)) then - call set_opt(env, 'maxcycle', sec) - else - call env%error("Integer argument for --cycles is missing", source) - end if + case ('--cycles') + call args%nextArg(sec) + if (allocated(sec)) then + call set_opt(env, 'maxcycle', sec) + else + call env%error("Integer argument for --cycles is missing", source) + end if - case ('-g', '--gbsa') + case ('-g', '--gbsa') + call args%nextArg(sec) + if (allocated(sec)) then + call set_gbsa(env, 'solvent', sec) + call set_gbsa(env, 'alpb', 'false') + call set_gbsa(env, 'kernel', 'still') call args%nextArg(sec) if (allocated(sec)) then - call set_gbsa(env, 'solvent', sec) - call set_gbsa(env, 'alpb', 'false') - call set_gbsa(env, 'kernel', 'still') - call args%nextArg(sec) - if (allocated(sec)) then - if (sec == 'reference') then - gsolvstate = solutionState%reference - else if (sec == 'bar1M') then - gsolvstate = solutionState%mol1bar - else - call env%warning("Unknown reference state '"//sec//"'", source) - end if + if (sec == 'reference') then + gsolvstate = solutionState%reference + else if (sec == 'bar1M') then + gsolvstate = solutionState%mol1bar + else + call env%warning("Unknown reference state '"//sec//"'", source) end if - else - call env%error("No solvent name provided for GBSA", source) end if + else + call env%error("No solvent name provided for GBSA", source) + end if - case ('--alpb') + case ('--alpb') + call args%nextArg(sec) + call set_gbsa(env, 'alpb', 'true') + if (allocated(sec)) then + call set_gbsa(env, 'solvent', sec) call args%nextArg(sec) - call set_gbsa(env, 'alpb', 'true') if (allocated(sec)) then - call set_gbsa(env, 'solvent', sec) - call args%nextArg(sec) - if (allocated(sec)) then - if (sec == 'reference') then - gsolvstate = solutionState%reference - else if (sec == 'bar1M') then - gsolvstate = solutionState%mol1bar - else - call env%warning("Unknown reference state '"//sec//"'", source) - end if + if (sec == 'reference') then + gsolvstate = solutionState%reference + else if (sec == 'bar1M') then + gsolvstate = solutionState%mol1bar + else + call env%warning("Unknown reference state '"//sec//"'", source) end if - else - call env%error("No solvent name provided for ALPB", source) end if + else + call env%error("No solvent name provided for ALPB", source) + end if - case ('--cosmo', '--tmcosmo') + case ('--cosmo', '--tmcosmo') + call args%nextArg(sec) + if (allocated(sec)) then + call set_gbsa(env, 'solvent', sec) + call set_gbsa(env, flag(3:), 'true') call args%nextArg(sec) if (allocated(sec)) then - call set_gbsa(env, 'solvent', sec) - call set_gbsa(env, flag(3:), 'true') - call args%nextArg(sec) - if (allocated(sec)) then - if (sec == 'reference') then - gsolvstate = 1 - else if (sec == 'bar1M') then - gsolvstate = 2 - else - call env%warning("Unknown reference state '"//sec//"'", source) - end if + if (sec == 'reference') then + gsolvstate = 1 + else if (sec == 'bar1M') then + gsolvstate = 2 + else + call env%warning("Unknown reference state '"//sec//"'", source) end if - else - call env%error("No solvent name provided for COSMO", source) end if + else + call env%error("No solvent name provided for COSMO", source) + end if - case ('--cpcmx') - if (get_xtb_feature('cpcmx')) then - call args%nextArg(sec) - if (allocated(sec)) then - call set_gbsa(env, 'solvent', 'infinity') - call set_gbsa(env, 'cosmo', 'true') - call set_gbsa(env, 'cpcmx', sec) - else - call env%error("No solvent name provided for CPCM-X", source) - end if + case ('--cpcmx') + if (get_xtb_feature('cpcmx')) then + call args%nextArg(sec) + if (allocated(sec)) then + call set_gbsa(env, 'solvent', 'infinity') + call set_gbsa(env, 'cosmo', 'true') + call set_gbsa(env, 'cpcmx', sec) else - call env%error("The CPCM-X library was not included in this version of xTB.", source) + call env%error("No solvent name provided for CPCM-X", source) end if + else + call env%error("The CPCM-X library was not included in this version of xTB.", source) + end if - case ('--scc', '--sp') - call set_runtyp('scc') - - case ('--vip') - call set_gfn(env, 'method', '1') - call set_runtyp('vip') - - case ('--vea') - call set_gfn(env, 'method', '1') - call set_runtyp('vea') - - case ('--vipea') - call set_gfn(env, 'method', '1') - call set_runtyp('vipea') + case ('--scc', '--sp') + call set_runtyp('scc') - case ('--vomega') - call set_gfn(env, 'method', '1') - call set_runtyp('vomega') + case ('--vip') + call set_gfn(env, 'method', '1') + call set_runtyp('vip') - case ('--vfukui') - call set_runtyp('vfukui') + case ('--vea') + call set_gfn(env, 'method', '1') + call set_runtyp('vea') - case ('--alpha') - call set_elprop('alpha') + case ('--vipea') + call set_gfn(env, 'method', '1') + call set_runtyp('vipea') - case ('--grad') - call set_runtyp('grad') - lgrad = .true. + case ('--vomega') + call set_gfn(env, 'method', '1') + call set_runtyp('vomega') - case ('-o', '--opt') - call set_runtyp('opt') - call args%nextArg(sec) - if (allocated(sec)) then - call set_opt(env, 'optlevel', sec) - end if + case ('--vfukui') + call set_runtyp('vfukui') - case ('--hess') - call set_runtyp('hess') + case ('--alpha') + call set_elprop('alpha') - case ('--md') - call set_runtyp('md') + case ('--grad') + call set_runtyp('grad') + lgrad = .true. - case ('--ohess') - call set_runtyp('ohess') - call args%nextArg(sec) - if (allocated(sec)) then - call set_opt(env, 'optlevel', sec) - end if + case ('-o', '--opt') + call set_runtyp('opt') + call args%nextArg(sec) + if (allocated(sec)) then + call set_opt(env, 'optlevel', sec) + end if - case ('--bhess') - call set_runtyp('bhess') - call args%nextArg(sec) - if (allocated(sec)) then - call set_opt(env, 'optlevel', sec) - end if + case ('--hess') + call set_runtyp('hess') - case ('--omd') - call set_runtyp('omd') - call set_opt(env, 'optlevel', '-1') + case ('--md') + call set_runtyp('md') - case ('--siman') - call set_runtyp('siman') - call set_md(env, 'nvt', 'true') + case ('--ohess') + call set_runtyp('ohess') + call args%nextArg(sec) + if (allocated(sec)) then + call set_opt(env, 'optlevel', sec) + end if - case ('--path') - call set_runtyp('path') - call args%nextArg(sec) - if (allocated(sec)) then - call set_path(env, 'product', sec) - end if + case ('--bhess') + call set_runtyp('bhess') + call args%nextArg(sec) + if (allocated(sec)) then + call set_opt(env, 'optlevel', sec) + end if - case ('--screen') - call set_runtyp('screen') + case ('--omd') + call set_runtyp('omd') + call set_opt(env, 'optlevel', '-1') - case ('--gmd') - call set_runtyp('gmd') - call env%error("This feature has been deprecated, I'm sorry.", source) + case ('--siman') + call set_runtyp('siman') + call set_md(env, 'nvt', 'true') - case ('--modef') - call set_runtyp('modef') - call args%nextArg(sec) - if (allocated(sec)) then - call set_modef(env, 'mode', sec) - end if + case ('--path') + call set_runtyp('path') + call args%nextArg(sec) + if (allocated(sec)) then + call set_path(env, 'product', sec) + end if - case ('--mdopt') - call set_runtyp('mdopt') + case ('--screen') + call set_runtyp('screen') - case ('--metadyn') - call set_runtyp('md') - call args%nextArg(sec) - if (allocated(sec)) then - call set_metadyn(env, 'save', sec) - end if - call set_metadyn(env, 'static', 'false') + case ('--gmd') + call set_runtyp('gmd') + call env%error("This feature has been deprecated, I'm sorry.", source) - case ('--metaopt') - call set_runtyp('metaopt') - call args%nextArg(sec) - if (allocated(sec)) then - call set_opt(env, 'optlevel', sec) - end if + case ('--modef') + call set_runtyp('modef') + call args%nextArg(sec) + if (allocated(sec)) then + call set_modef(env, 'mode', sec) + end if - case ('--nat') - call args%nextArg(sec) - if (allocated(sec)) then - call set_natom(env, sec) - end if + case ('--mdopt') + call set_runtyp('mdopt') - case ('--bias-input', '--gesc') - call args%nextArg(sec) - if (allocated(sec)) then - call set_metadyn(env, 'bias-input', sec) - else - call env%error("No input file for RMSD bias provided", source) - end if + case ('--metadyn') + call set_runtyp('md') + call args%nextArg(sec) + if (allocated(sec)) then + call set_metadyn(env, 'save', sec) + end if + call set_metadyn(env, 'static', 'false') - case ('--wrtopo') - call args%nextArg(sec) - if (allocated(sec)) then - call setWRtopo(sec, printTopo) - if (printTopo%warning) call env%error("A wrtopo argument has been misspelled.", source) - else - call env%error("The wrtopo keyword is missing an argument.", source) - end if - end select - call args%nextFlag(flag) - end do + case ('--metaopt') + call set_runtyp('metaopt') + call args%nextArg(sec) + if (allocated(sec)) then + call set_opt(env, 'optlevel', sec) + end if - end subroutine parseArguments - - function read_whole_file(fname) result(list) - character(len=*), intent(in) :: fname - character(len=:), allocatable :: list - integer :: io, stat - character(len=:), allocatable :: line - open (newunit=io, file=fname, iostat=stat) - call getline(io, list, stat) - do while (stat == 0) - call getline(io, line, stat) - if (stat == 0) list = list//","//line - end do - close (io, iostat=stat) - end function read_whole_file + case ('--nat') + call args%nextArg(sec) + if (allocated(sec)) then + call set_natom(env, sec) + end if -! set booleans for requested topology list printout - subroutine setWRtopo(sec, printTopo) - ! command line argument - character(len=*), intent(in) :: sec - ! type holds booleans of to be printed topology lists - type(TPrintTopo), intent(inout) :: printTopo - ! seperator for lists is "," - character, parameter :: sep = "," - ! current and old position of seperator - integer :: curr_pos, old_pos - integer :: lenSec, i - - curr_pos = 0 - old_pos = 0 - lenSec = len(sec) - do i = 1, lenSec - curr_pos = scan(sec(curr_pos + 1:lenSec), sep) + old_pos - if (curr_pos .ne. old_pos) then - call selectList(sec(old_pos + 1:curr_pos - 1), printTopo) + case ('--bias-input', '--gesc') + call args%nextArg(sec) + if (allocated(sec)) then + call set_metadyn(env, 'bias-input', sec) else - call selectList(sec(old_pos + 1:lenSec), printTopo) - exit + call env%error("No input file for RMSD bias provided", source) end if - old_pos = curr_pos - end do - end subroutine setWRtopo - - subroutine selectList(secSplit, printTopo) - ! part of command line argument - character(len=*), intent(in) :: secSplit - ! holds booleans of to be printed topology lists - type(TPrintTopo), intent(inout) :: printTopo - - select case (secSplit) - case ("etot") - printTopo%etot = .true. - case ("gnorm") - printTopo%gnorm = .true. - case ("nb") - printTopo%nb = .true. - case ("bpair") - printTopo%bpair = .true. - case ("alist") - printTopo%alist = .true. - case ("blist") - printTopo%blist = .true. - case ("tlist") - printTopo%tlist = .true. - case ("vtors") - printTopo%vtors = .true. - case ("vbond") - printTopo%vbond = .true. - case ("vangl") - printTopo%vangl = .true. - case ("hbbond") - printTopo%hbbond = .true. - case ("eeq") - printTopo%eeq = .true. - case ("json") - printTopo%etot = .true. - printTopo%gnorm = .true. - printTopo%nb = .true. - printTopo%bpair = .true. - printTopo%alist = .true. - printTopo%blist = .true. - printTopo%tlist = .true. - printTopo%vtors = .true. - printTopo%vbond = .true. - printTopo%vangl = .true. - printTopo%hbbond = .true. - printTopo%eeq = .true. - case default - printTopo%warning = .true. + case ('--wrtopo') + call args%nextArg(sec) + if (allocated(sec)) then + call setWRtopo(sec, printTopo) + if (printTopo%warning) call env%error("A wrtopo argument has been misspelled.", source) + else + call env%error("The wrtopo keyword is missing an argument.", source) + end if end select - end subroutine selectList + call args%nextFlag(flag) + end do + +end subroutine parseArguments + +function read_whole_file(fname) result(list) + character(len=*), intent(in) :: fname + character(len=:), allocatable :: list + integer :: io, stat + character(len=:), allocatable :: line + open (newunit=io, file=fname, iostat=stat) + call getline(io, list, stat) + do while (stat == 0) + call getline(io, line, stat) + if (stat == 0) list = list//","//line + end do + close (io, iostat=stat) +end function read_whole_file + +! set booleans for requested topology list printout +subroutine setWRtopo(sec, printTopo) + ! command line argument + character(len=*), intent(in) :: sec + ! type holds booleans of to be printed topology lists + type(TPrintTopo), intent(inout) :: printTopo + ! seperator for lists is "," + character, parameter :: sep = "," + ! current and old position of seperator + integer :: curr_pos, old_pos + integer :: lenSec, i + + curr_pos = 0 + old_pos = 0 + lenSec = len(sec) + do i = 1, lenSec + curr_pos = scan(sec(curr_pos + 1:lenSec), sep) + old_pos + if (curr_pos .ne. old_pos) then + call selectList(sec(old_pos + 1:curr_pos - 1), printTopo) + else + call selectList(sec(old_pos + 1:lenSec), printTopo) + exit + end if + old_pos = curr_pos + end do + +end subroutine setWRtopo + +subroutine selectList(secSplit, printTopo) + ! part of command line argument + character(len=*), intent(in) :: secSplit + ! holds booleans of to be printed topology lists + type(TPrintTopo), intent(inout) :: printTopo + + select case (secSplit) + case ("etot") + printTopo%etot = .true. + case ("gnorm") + printTopo%gnorm = .true. + case ("nb") + printTopo%nb = .true. + case ("bpair") + printTopo%bpair = .true. + case ("alist") + printTopo%alist = .true. + case ("blist") + printTopo%blist = .true. + case ("tlist") + printTopo%tlist = .true. + case ("vtors") + printTopo%vtors = .true. + case ("vbond") + printTopo%vbond = .true. + case ("vangl") + printTopo%vangl = .true. + case ("hbbond") + printTopo%hbbond = .true. + case ("eeq") + printTopo%eeq = .true. + case ("json") + printTopo%etot = .true. + printTopo%gnorm = .true. + printTopo%nb = .true. + printTopo%bpair = .true. + printTopo%alist = .true. + printTopo%blist = .true. + printTopo%tlist = .true. + printTopo%vtors = .true. + printTopo%vbond = .true. + printTopo%vangl = .true. + printTopo%hbbond = .true. + printTopo%eeq = .true. + case default + printTopo%warning = .true. + end select +end subroutine selectList #if ! WITH_TBLITE subroutine ptb_feature_not_implemented(env) diff --git a/src/type/param.f90 b/src/type/param.f90 index 13f1f0298..2b18b1455 100644 --- a/src/type/param.f90 +++ b/src/type/param.f90 @@ -118,37 +118,37 @@ module xtb_type_param contains - subroutine allocate_chrgeq(self, n, extended) - implicit none - class(chrg_parameter) :: self - integer, intent(in) :: n - logical, intent(in), optional :: extended - logical :: multipoles - if (present(extended)) then - multipoles = extended - else - multipoles = .false. - end if - call self%deallocate - allocate (self%en(n), source=0.0_wp) - allocate (self%gam(n), source=0.0_wp) - allocate (self%kappa(n), source=0.0_wp) - allocate (self%alpha(n), source=0.0_wp) - if (multipoles) then - allocate (self%dpol(n), source=0.0_wp) - allocate (self%beta(n), source=0.0_wp) - end if - end subroutine allocate_chrgeq +subroutine allocate_chrgeq(self, n, extended) + implicit none + class(chrg_parameter) :: self + integer, intent(in) :: n + logical, intent(in), optional :: extended + logical :: multipoles + if (present(extended)) then + multipoles = extended + else + multipoles = .false. + end if + call self%deallocate + allocate (self%en(n), source=0.0_wp) + allocate (self%gam(n), source=0.0_wp) + allocate (self%kappa(n), source=0.0_wp) + allocate (self%alpha(n), source=0.0_wp) + if (multipoles) then + allocate (self%dpol(n), source=0.0_wp) + allocate (self%beta(n), source=0.0_wp) + end if +end subroutine allocate_chrgeq - subroutine deallocate_chrgeq(self) - implicit none - class(chrg_parameter) :: self - if (allocated(self%en)) deallocate (self%en) - if (allocated(self%gam)) deallocate (self%gam) - if (allocated(self%kappa)) deallocate (self%kappa) - if (allocated(self%alpha)) deallocate (self%alpha) - if (allocated(self%dpol)) deallocate (self%dpol) - if (allocated(self%beta)) deallocate (self%beta) - end subroutine deallocate_chrgeq +subroutine deallocate_chrgeq(self) + implicit none + class(chrg_parameter) :: self + if (allocated(self%en)) deallocate (self%en) + if (allocated(self%gam)) deallocate (self%gam) + if (allocated(self%kappa)) deallocate (self%kappa) + if (allocated(self%alpha)) deallocate (self%alpha) + if (allocated(self%dpol)) deallocate (self%dpol) + if (allocated(self%beta)) deallocate (self%beta) +end subroutine deallocate_chrgeq end module xtb_type_param diff --git a/subprojects/json-fortran-8.2.5.wrap b/subprojects/json-fortran-8.2.5.wrap new file mode 100644 index 000000000..f3675a6a6 --- /dev/null +++ b/subprojects/json-fortran-8.2.5.wrap @@ -0,0 +1,2 @@ +[wrap-redirect] +filename = mctc-lib/subprojects/json-fortran-8.2.5.wrap diff --git a/test/unit/main.f90 b/test/unit/main.f90 index 43ad918d9..761bb57b8 100644 --- a/test/unit/main.f90 +++ b/test/unit/main.f90 @@ -124,132 +124,132 @@ program tester contains - !> Driver for testsuite - subroutine run_testsuite(collect, unit, stat) +!> Driver for testsuite +subroutine run_testsuite(collect, unit, stat) - !> Collect tests - procedure(collect_interface) :: collect + !> Collect tests + procedure(collect_interface) :: collect - !> Unit for IO - integer, intent(in) :: unit + !> Unit for IO + integer, intent(in) :: unit - !> Number of failed tests - integer, intent(inout) :: stat + !> Number of failed tests + integer, intent(inout) :: stat - type(unittest_type), allocatable :: testsuite(:) - integer :: it + type(unittest_type), allocatable :: testsuite(:) + integer :: it - call collect(testsuite) + call collect(testsuite) - do it = 1, size(testsuite) - !$omp critical(testdrive_testsuite) - write(unit, '(1x, 3(1x, a), 1x, "(", i0, "/", i0, ")")') & - & "Starting", testsuite(it)%name, "...", it, size(testsuite) - !$omp end critical(testdrive_testsuite) - call run_unittest(testsuite(it), unit, stat) - end do + do it = 1, size(testsuite) + !$omp critical(testdrive_testsuite) + write(unit, '(1x, 3(1x, a), 1x, "(", i0, "/", i0, ")")') & + & "Starting", testsuite(it)%name, "...", it, size(testsuite) + !$omp end critical(testdrive_testsuite) + call run_unittest(testsuite(it), unit, stat) + end do - end subroutine run_testsuite +end subroutine run_testsuite - !> Run a selected unit test - subroutine run_unittest(test, unit, stat) +!> Run a selected unit test +subroutine run_unittest(test, unit, stat) - !> Unit test - type(unittest_type), intent(in) :: test + !> Unit test + type(unittest_type), intent(in) :: test - !> Unit for IO - integer, intent(in) :: unit + !> Unit for IO + integer, intent(in) :: unit - !> Number of failed tests - integer, intent(inout) :: stat + !> Number of failed tests + integer, intent(inout) :: stat - type(error_type), allocatable :: error - character(len=:), allocatable :: message + type(error_type), allocatable :: error + character(len=:), allocatable :: message - call test%test(error) - if (.not.test_skipped(error) .and. allocated(error) .neqv. test%should_fail) then - stat = stat + 1 - end if - call make_output(message, test, error) - !$omp critical(testdrive_testsuite) - write(unit, '(a)') message - !$omp end critical(testdrive_testsuite) - if (allocated(error)) then - call clear_error(error) - end if + call test%test(error) + if (.not.test_skipped(error) .and. allocated(error) .neqv. test%should_fail) then + stat = stat + 1 + end if + call make_output(message, test, error) + !$omp critical(testdrive_testsuite) + write(unit, '(a)') message + !$omp end critical(testdrive_testsuite) + if (allocated(error)) then + call clear_error(error) + end if - end subroutine run_unittest +end subroutine run_unittest - !> Create output message for test (this procedure is pure and therefore cannot launch tests) - pure subroutine make_output(output, test, error) +!> Create output message for test (this procedure is pure and therefore cannot launch tests) +pure subroutine make_output(output, test, error) - !> Output message for display - character(len=:), allocatable, intent(out) :: output + !> Output message for display + character(len=:), allocatable, intent(out) :: output - !> Unit test - type(unittest_type), intent(in) :: test + !> Unit test + type(unittest_type), intent(in) :: test - !> Error handling - type(error_type), intent(in), optional :: error + !> Error handling + type(error_type), intent(in), optional :: error - character(len=:), allocatable :: label - character(len=*), parameter :: indent = repeat(" ", 7) // repeat(".", 3) // " " + character(len=:), allocatable :: label + character(len=*), parameter :: indent = repeat(" ", 7) // repeat(".", 3) // " " - if (test_skipped(error)) then - output = indent // test%name // " [SKIPPED]" & - & // new_line("a") // " Message: " // error%message - return - end if + if (test_skipped(error)) then + output = indent // test%name // " [SKIPPED]" & + & // new_line("a") // " Message: " // error%message + return + end if - if (present(error) .neqv. test%should_fail) then - if (test%should_fail) then - label = " [UNEXPECTED PASS]" - else - label = " [FAILED]" - end if + if (present(error) .neqv. test%should_fail) then + if (test%should_fail) then + label = " [UNEXPECTED PASS]" else - if (test%should_fail) then - label = " [EXPECTED FAIL]" - else - label = " [PASSED]" - end if + label = " [FAILED]" end if - output = indent // test%name // label - if (present(error)) then - output = output // new_line("a") // " Message: " // error%message + else + if (test%should_fail) then + label = " [EXPECTED FAIL]" + else + label = " [PASSED]" end if - end subroutine make_output + end if + output = indent // test%name // label + if (present(error)) then + output = output // new_line("a") // " Message: " // error%message + end if +end subroutine make_output - pure function test_skipped(error) result(is_skipped) +pure function test_skipped(error) result(is_skipped) - !> Error handling - type(error_type), intent(in), optional :: error + !> Error handling + type(error_type), intent(in), optional :: error - !> Test was skipped - logical :: is_skipped + !> Test was skipped + logical :: is_skipped - is_skipped = .false. - if (present(error)) then - is_skipped = error%stat == 77 - end if + is_skipped = .false. + if (present(error)) then + is_skipped = error%stat == 77 + end if - end function test_skipped +end function test_skipped - !> Clear error type after it has been handled. - subroutine clear_error(error) +!> Clear error type after it has been handled. +subroutine clear_error(error) - !> Error handling - type(error_type), intent(inout) :: error + !> Error handling + type(error_type), intent(inout) :: error - if (error%stat /= 0) then - error%stat = 0 - end if + if (error%stat /= 0) then + error%stat = 0 + end if - if (allocated(error%message)) then - deallocate(error%message) - end if + if (allocated(error%message)) then + deallocate(error%message) + end if - end subroutine clear_error +end subroutine clear_error end program tester diff --git a/test/unit/molstock.f90 b/test/unit/molstock.f90 index 9dba44199..5704c9496 100644 --- a/test/unit/molstock.f90 +++ b/test/unit/molstock.f90 @@ -26,64 +26,64 @@ module xtb_test_molstock contains - subroutine getMolecule(mol, name) - type(TMolecule), intent(out) :: mol - character(len=*), intent(in) :: name +subroutine getMolecule(mol, name) + type(TMolecule), intent(out) :: mol + character(len=*), intent(in) :: name - select case (name) - case ('mindless01'); call mindless01(mol) - case ('mindless02'); call mindless02(mol) - case ('mindless03'); call mindless03(mol) - case ('mindless04'); call mindless04(mol) - case ('mindless05'); call mindless05(mol) - case ('mindless06'); call mindless06(mol) - case ('mindless07'); call mindless07(mol) - case ('mindless08'); call mindless08(mol) - case ('mindless09'); call mindless09(mol) - case ('mindless10'); call mindless10(mol) - case ('caffeine'); call caffeine(mol) - case ('rivaroxaban'); call rivaroxaban(mol) - case ('grubbs'); call grubbs(mol) - case ('remdesivir'); call remdesivir(mol) - case ('taxol'); call taxol(mol) - case ('pdb-4qxx'); call pdb_4qxx(mol) - case ('bug332'); call bug332(mol) - case ('manganese'); call manganese(mol) - case ('vcpco4'); call vcpco4(mol) - case ('feco5'); call feco5(mol) - case ('co_cnx6'); call co_cnx6(mol) - case ('fe_cnx6'); call fe_cnx6(mol) - case ('h2o'); call h2o(mol) - case ('mgh2'); call MgH2(mol) - end select + select case (name) + case ('mindless01'); call mindless01(mol) + case ('mindless02'); call mindless02(mol) + case ('mindless03'); call mindless03(mol) + case ('mindless04'); call mindless04(mol) + case ('mindless05'); call mindless05(mol) + case ('mindless06'); call mindless06(mol) + case ('mindless07'); call mindless07(mol) + case ('mindless08'); call mindless08(mol) + case ('mindless09'); call mindless09(mol) + case ('mindless10'); call mindless10(mol) + case ('caffeine'); call caffeine(mol) + case ('rivaroxaban'); call rivaroxaban(mol) + case ('grubbs'); call grubbs(mol) + case ('remdesivir'); call remdesivir(mol) + case ('taxol'); call taxol(mol) + case ('pdb-4qxx'); call pdb_4qxx(mol) + case ('bug332'); call bug332(mol) + case ('manganese'); call manganese(mol) + case ('vcpco4'); call vcpco4(mol) + case ('feco5'); call feco5(mol) + case ('co_cnx6'); call co_cnx6(mol) + case ('fe_cnx6'); call fe_cnx6(mol) + case ('h2o'); call h2o(mol) + case ('mgh2'); call MgH2(mol) + end select - end subroutine getMolecule +end subroutine getMolecule - subroutine mindless01(mol) - type(TMolecule), intent(out) :: mol - integer, parameter :: nat = 16 - character(len=*), parameter :: sym(nat) = [character(len=4) ::& - & "Na", "H", "O", "H", "F", "H", "H", "O", "N", "H", "H", "Cl", "B", "B", "N", "Al"] - real(wp), parameter :: xyz(3, nat) = reshape([& - & -1.85528263484662_wp, 3.58670515364616_wp, -2.41763729306344_wp, & - & 4.40178023537845_wp, 0.02338844412653_wp, -4.95457749372945_wp, & - & -2.98706033463438_wp, 4.76252065456814_wp, 1.27043301573532_wp, & - & 0.79980886075526_wp, 1.41103455609189_wp, -5.04655321620119_wp, & - & -4.20647469409936_wp, 1.84275767548460_wp, 4.55038084858449_wp, & - & -3.54356121843970_wp, -3.18835665176557_wp, 1.46240021785588_wp, & - & 2.70032160109941_wp, 1.06818452504054_wp, -1.73234650374438_wp, & - & 3.73114088824361_wp, -2.07001543363453_wp, 2.23160937604731_wp, & - & -1.75306819230397_wp, 0.35951417150421_wp, 1.05323406177129_wp, & - & 5.41755788583825_wp, -1.57881830078929_wp, 1.75394002750038_wp, & - & -2.23462868255966_wp, -2.13856505054269_wp, 4.10922285746451_wp, & - & 1.01565866207568_wp, -3.21952154552768_wp, -3.36050963020778_wp, & - & 2.42119255723593_wp, 0.26626435093114_wp, -3.91862474360560_wp, & - & -3.02526098819107_wp, 2.53667889095925_wp, 2.31664984740423_wp, & - & -2.00438948664892_wp, -2.29235136977220_wp, 2.19782807357059_wp, & - & 1.12226554109716_wp, -1.36942007032045_wp, 0.48455055461782_wp],& - & shape(xyz)) - call init(mol, sym, xyz) - end subroutine mindless01 +subroutine mindless01(mol) + type(TMolecule), intent(out) :: mol + integer, parameter :: nat = 16 + character(len=*), parameter :: sym(nat) = [character(len=4) ::& + & "Na", "H", "O", "H", "F", "H", "H", "O", "N", "H", "H", "Cl", "B", "B", "N", "Al"] + real(wp), parameter :: xyz(3, nat) = reshape([& + & -1.85528263484662_wp, 3.58670515364616_wp, -2.41763729306344_wp, & + & 4.40178023537845_wp, 0.02338844412653_wp, -4.95457749372945_wp, & + & -2.98706033463438_wp, 4.76252065456814_wp, 1.27043301573532_wp, & + & 0.79980886075526_wp, 1.41103455609189_wp, -5.04655321620119_wp, & + & -4.20647469409936_wp, 1.84275767548460_wp, 4.55038084858449_wp, & + & -3.54356121843970_wp, -3.18835665176557_wp, 1.46240021785588_wp, & + & 2.70032160109941_wp, 1.06818452504054_wp, -1.73234650374438_wp, & + & 3.73114088824361_wp, -2.07001543363453_wp, 2.23160937604731_wp, & + & -1.75306819230397_wp, 0.35951417150421_wp, 1.05323406177129_wp, & + & 5.41755788583825_wp, -1.57881830078929_wp, 1.75394002750038_wp, & + & -2.23462868255966_wp, -2.13856505054269_wp, 4.10922285746451_wp, & + & 1.01565866207568_wp, -3.21952154552768_wp, -3.36050963020778_wp, & + & 2.42119255723593_wp, 0.26626435093114_wp, -3.91862474360560_wp, & + & -3.02526098819107_wp, 2.53667889095925_wp, 2.31664984740423_wp, & + & -2.00438948664892_wp, -2.29235136977220_wp, 2.19782807357059_wp, & + & 1.12226554109716_wp, -1.36942007032045_wp, 0.48455055461782_wp],& + & shape(xyz)) + call init(mol, sym, xyz) +end subroutine mindless01 subroutine mindless02(mol) type(TMolecule), intent(out) :: mol @@ -113,1031 +113,1031 @@ subroutine mindless02(mol) end subroutine mindless02 - subroutine mindless03(mol) - type(TMolecule), intent(out) :: mol - integer, parameter :: nat = 16 - character(len=*), parameter :: sym(nat) = [character(len=4) ::& - & "C", "O", "H", "Li", "Mg", "Al", "C", "H", "H", "H", "F", "S", "C", "H", "Na", "H"] - real(wp), parameter :: xyz(3, nat) = reshape([& - & -0.02148551327524_wp, -0.67161751504297_wp, -4.75078512817560_wp, & - & 1.37792545875526_wp, -3.24818416423144_wp, 3.83896600631495_wp, & - & -2.23986953822894_wp, 1.64550402751694_wp, 3.42773272178522_wp, & - & -0.87622711432790_wp, -2.74068400827752_wp, 1.43723692979592_wp, & - & 1.29492470653815_wp, 1.86470311043681_wp, -1.04536500695239_wp, & - & -3.65768365013010_wp, 0.45437052179208_wp, -1.41566056087159_wp, & - & -0.23245910487384_wp, -1.83274112101585_wp, -2.43395808606122_wp, & - & 0.30373451850419_wp, -3.84228931776777_wp, -2.44882782867802_wp, & - & -3.36159503902161_wp, 4.20056392581975_wp, 1.63352684198071_wp, & - & 0.49372989648081_wp, -1.56245253044952_wp, -6.53610501083288_wp, & - & 4.38566058812996_wp, 1.86127331114460_wp, 0.56178822055152_wp, & - & -1.17545963764009_wp, 2.49456345795141_wp, -4.90195191215762_wp, & - & -1.86623614216854_wp, 2.76329843590746_wp, 1.71572598870213_wp, & - & 1.02361259176985_wp, -4.24377370348987_wp, 5.32418288889440_wp, & - & 4.71194535010347_wp, -1.03648125005561_wp, 3.35573062118779_wp, & - & -0.16051737061546_wp, 3.89394681976155_wp, 2.23776331451663_wp],& - & shape(xyz)) - call init(mol, sym, xyz) - end subroutine mindless03 +subroutine mindless03(mol) + type(TMolecule), intent(out) :: mol + integer, parameter :: nat = 16 + character(len=*), parameter :: sym(nat) = [character(len=4) ::& + & "C", "O", "H", "Li", "Mg", "Al", "C", "H", "H", "H", "F", "S", "C", "H", "Na", "H"] + real(wp), parameter :: xyz(3, nat) = reshape([& + & -0.02148551327524_wp, -0.67161751504297_wp, -4.75078512817560_wp, & + & 1.37792545875526_wp, -3.24818416423144_wp, 3.83896600631495_wp, & + & -2.23986953822894_wp, 1.64550402751694_wp, 3.42773272178522_wp, & + & -0.87622711432790_wp, -2.74068400827752_wp, 1.43723692979592_wp, & + & 1.29492470653815_wp, 1.86470311043681_wp, -1.04536500695239_wp, & + & -3.65768365013010_wp, 0.45437052179208_wp, -1.41566056087159_wp, & + & -0.23245910487384_wp, -1.83274112101585_wp, -2.43395808606122_wp, & + & 0.30373451850419_wp, -3.84228931776777_wp, -2.44882782867802_wp, & + & -3.36159503902161_wp, 4.20056392581975_wp, 1.63352684198071_wp, & + & 0.49372989648081_wp, -1.56245253044952_wp, -6.53610501083288_wp, & + & 4.38566058812996_wp, 1.86127331114460_wp, 0.56178822055152_wp, & + & -1.17545963764009_wp, 2.49456345795141_wp, -4.90195191215762_wp, & + & -1.86623614216854_wp, 2.76329843590746_wp, 1.71572598870213_wp, & + & 1.02361259176985_wp, -4.24377370348987_wp, 5.32418288889440_wp, & + & 4.71194535010347_wp, -1.03648125005561_wp, 3.35573062118779_wp, & + & -0.16051737061546_wp, 3.89394681976155_wp, 2.23776331451663_wp],& + & shape(xyz)) + call init(mol, sym, xyz) +end subroutine mindless03 - subroutine mindless04(mol) - type(TMolecule), intent(out) :: mol - integer, parameter :: nat = 16 - character(len=*), parameter :: sym(nat) = [character(len=4) ::& - & "H", "B", "H", "F", "B", "H", "H", "Si", "H", "H", "C", "Al", "Si", "O", "H", "B"] - real(wp), parameter :: xyz(3, nat) = reshape([& - & -1.34544890768411_wp, 2.85946545334720_wp, 3.11183388215396_wp, & - & -0.36293929605305_wp, 4.15983774640545_wp, 1.36413101934678_wp, & - & -3.36268280924844_wp, 4.92951597114402_wp, -3.59085684882314_wp, & - & 3.78143178536443_wp, -4.97181356229699_wp, 1.59003443639387_wp, & - & 3.44227417874042_wp, -3.46504338606415_wp, 3.62082644591507_wp, & - & 1.88917586252014_wp, 3.42088101960529_wp, 1.28872629783483_wp, & - & -0.32747529934233_wp, -4.29711514977711_wp, -3.55330460209973_wp, & - & -3.58768360829779_wp, -1.39509759062952_wp, -1.10396714572410_wp, & - & -0.39440896193088_wp, 6.31837673143592_wp, 1.99105318714945_wp, & - & 4.34376903295874_wp, -4.12502353873667_wp, 5.57829602371555_wp, & - & -1.39570266622309_wp, -2.60410756418652_wp, -4.03149806979915_wp, & - & 0.21788515354592_wp, 0.28610741675369_wp, 1.29731097788136_wp, & - & -2.00000183598828_wp, 3.04473467156937_wp, -2.00578147078785_wp, & - & 2.12833842504876_wp, -1.30141517432227_wp, 3.38069910888504_wp, & - & -2.48411958079522_wp, -2.81581487156584_wp, -5.76829803496286_wp, & - & -0.54241147261516_wp, -0.04348817268188_wp, -3.16920520707912_wp],& - & shape(xyz)) - call init(mol, sym, xyz) - end subroutine mindless04 +subroutine mindless04(mol) + type(TMolecule), intent(out) :: mol + integer, parameter :: nat = 16 + character(len=*), parameter :: sym(nat) = [character(len=4) ::& + & "H", "B", "H", "F", "B", "H", "H", "Si", "H", "H", "C", "Al", "Si", "O", "H", "B"] + real(wp), parameter :: xyz(3, nat) = reshape([& + & -1.34544890768411_wp, 2.85946545334720_wp, 3.11183388215396_wp, & + & -0.36293929605305_wp, 4.15983774640545_wp, 1.36413101934678_wp, & + & -3.36268280924844_wp, 4.92951597114402_wp, -3.59085684882314_wp, & + & 3.78143178536443_wp, -4.97181356229699_wp, 1.59003443639387_wp, & + & 3.44227417874042_wp, -3.46504338606415_wp, 3.62082644591507_wp, & + & 1.88917586252014_wp, 3.42088101960529_wp, 1.28872629783483_wp, & + & -0.32747529934233_wp, -4.29711514977711_wp, -3.55330460209973_wp, & + & -3.58768360829779_wp, -1.39509759062952_wp, -1.10396714572410_wp, & + & -0.39440896193088_wp, 6.31837673143592_wp, 1.99105318714945_wp, & + & 4.34376903295874_wp, -4.12502353873667_wp, 5.57829602371555_wp, & + & -1.39570266622309_wp, -2.60410756418652_wp, -4.03149806979915_wp, & + & 0.21788515354592_wp, 0.28610741675369_wp, 1.29731097788136_wp, & + & -2.00000183598828_wp, 3.04473467156937_wp, -2.00578147078785_wp, & + & 2.12833842504876_wp, -1.30141517432227_wp, 3.38069910888504_wp, & + & -2.48411958079522_wp, -2.81581487156584_wp, -5.76829803496286_wp, & + & -0.54241147261516_wp, -0.04348817268188_wp, -3.16920520707912_wp],& + & shape(xyz)) + call init(mol, sym, xyz) +end subroutine mindless04 - subroutine mindless05(mol) - type(TMolecule), intent(out) :: mol - integer, parameter :: nat = 16 - character(len=*), parameter :: sym(nat) = [character(len=4) ::& - & "B", "P", "H", "H", "B", "P", "H", "Cl", "N", "H", "P", "Si", "H", "H", "P", "N"] - real(wp), parameter :: xyz(3, nat) = reshape([& - & 0.68391902268453_wp, 0.21679405065309_wp, -2.81441127558071_wp, & - & -2.67199537993843_wp, -3.97743927106200_wp, 0.03497540139192_wp, & - & 2.02325266152397_wp, -0.16048070975416_wp, -0.41980608052722_wp, & - & 4.26224346168617_wp, 3.65384961705338_wp, -2.81836810458488_wp, & - & -2.80378310343644_wp, 1.84796600006216_wp, 0.15107304476153_wp, & - & 1.58317082705122_wp, 3.77079801391042_wp, -2.86230158107979_wp, & - & 2.63670178694113_wp, 3.13142099211650_wp, 2.24139937019049_wp, & - & -6.27112533979613_wp, -3.92471014080274_wp, 1.62562669834852_wp, & - & -0.92594349239390_wp, -2.94451283088352_wp, 2.60616476876177_wp, & - & -1.79532342290201_wp, -1.56841672860834_wp, 3.65515689388732_wp, & - & -3.01460634915379_wp, -0.47748181717446_wp, -2.44834110183776_wp, & - & 2.18249449208515_wp, -2.23505035804805_wp, 1.77725119258081_wp, & - & 3.26068149442689_wp, -4.54078259646428_wp, 0.57204329987377_wp, & - & 1.73744972267909_wp, -1.18654391698320_wp, -4.24063427353503_wp, & - & 0.94405328902426_wp, 4.99525793054843_wp, 1.18501287451328_wp, & - & -1.83118967048165_wp, 3.39933176543682_wp, 1.75515887283605_wp],& - & shape(xyz)) - integer, parameter :: uhf = 1 - call init(mol, sym, xyz, uhf=uhf) - end subroutine mindless05 +subroutine mindless05(mol) + type(TMolecule), intent(out) :: mol + integer, parameter :: nat = 16 + character(len=*), parameter :: sym(nat) = [character(len=4) ::& + & "B", "P", "H", "H", "B", "P", "H", "Cl", "N", "H", "P", "Si", "H", "H", "P", "N"] + real(wp), parameter :: xyz(3, nat) = reshape([& + & 0.68391902268453_wp, 0.21679405065309_wp, -2.81441127558071_wp, & + & -2.67199537993843_wp, -3.97743927106200_wp, 0.03497540139192_wp, & + & 2.02325266152397_wp, -0.16048070975416_wp, -0.41980608052722_wp, & + & 4.26224346168617_wp, 3.65384961705338_wp, -2.81836810458488_wp, & + & -2.80378310343644_wp, 1.84796600006216_wp, 0.15107304476153_wp, & + & 1.58317082705122_wp, 3.77079801391042_wp, -2.86230158107979_wp, & + & 2.63670178694113_wp, 3.13142099211650_wp, 2.24139937019049_wp, & + & -6.27112533979613_wp, -3.92471014080274_wp, 1.62562669834852_wp, & + & -0.92594349239390_wp, -2.94451283088352_wp, 2.60616476876177_wp, & + & -1.79532342290201_wp, -1.56841672860834_wp, 3.65515689388732_wp, & + & -3.01460634915379_wp, -0.47748181717446_wp, -2.44834110183776_wp, & + & 2.18249449208515_wp, -2.23505035804805_wp, 1.77725119258081_wp, & + & 3.26068149442689_wp, -4.54078259646428_wp, 0.57204329987377_wp, & + & 1.73744972267909_wp, -1.18654391698320_wp, -4.24063427353503_wp, & + & 0.94405328902426_wp, 4.99525793054843_wp, 1.18501287451328_wp, & + & -1.83118967048165_wp, 3.39933176543682_wp, 1.75515887283605_wp],& + & shape(xyz)) + integer, parameter :: uhf = 1 + call init(mol, sym, xyz, uhf=uhf) +end subroutine mindless05 - subroutine mindless06(mol) - type(TMolecule), intent(out) :: mol - integer, parameter :: nat = 16 - character(len=*), parameter :: sym(nat) = [character(len=4) ::& - & "B", "N", "H", "O", "B", "H", "Al", "H", "B", "Mg", "H", "H", "H", "H", "C", "H"] - real(wp), parameter :: xyz(3, nat) = reshape([& - & 0.10912945825730_wp, 1.64180252123600_wp, 0.27838149792131_wp, & - & -2.30085163837888_wp, 0.87765138232225_wp, -0.60457694150897_wp, & - & 2.78083551168063_wp, 4.95421363506113_wp, 0.40788634984219_wp, & - & -5.36229602768251_wp, -7.29510945515334_wp, 0.06097106408867_wp, & - & 2.13846114572058_wp, -0.99012126457352_wp, 0.93647189687052_wp, & - & 0.09330150731888_wp, -2.75648066796634_wp, -3.70294675694565_wp, & - & -1.52684105316140_wp, -2.44981814860506_wp, -1.02727325811774_wp, & - & -0.45240334635443_wp, 5.86105501765814_wp, 0.30815308772432_wp, & - & -3.95419048213910_wp, -5.52061943693205_wp, -0.31702321028260_wp, & - & 2.68706169520082_wp, -0.13577304635533_wp, -3.57041492458512_wp, & - & -3.79914135008731_wp, 2.06429808651079_wp, -0.77285245656187_wp, & - & 0.89693752015341_wp, 4.58640300917890_wp, 3.09718012019731_wp, & - & 2.76317093138142_wp, -0.62928000132252_wp, 3.08807601371151_wp, & - & 1.00075543259914_wp, -3.11885279872042_wp, 1.08659460804098_wp, & - & 0.86969979951508_wp, 4.43363816376984_wp, 1.02355776570620_wp, & - & 4.05637089597643_wp, -1.52300699610852_wp, -0.29218485610105_wp],& - & shape(xyz)) - integer, parameter :: uhf = 1 - call init(mol, sym, xyz, uhf=uhf) - end subroutine mindless06 +subroutine mindless06(mol) + type(TMolecule), intent(out) :: mol + integer, parameter :: nat = 16 + character(len=*), parameter :: sym(nat) = [character(len=4) ::& + & "B", "N", "H", "O", "B", "H", "Al", "H", "B", "Mg", "H", "H", "H", "H", "C", "H"] + real(wp), parameter :: xyz(3, nat) = reshape([& + & 0.10912945825730_wp, 1.64180252123600_wp, 0.27838149792131_wp, & + & -2.30085163837888_wp, 0.87765138232225_wp, -0.60457694150897_wp, & + & 2.78083551168063_wp, 4.95421363506113_wp, 0.40788634984219_wp, & + & -5.36229602768251_wp, -7.29510945515334_wp, 0.06097106408867_wp, & + & 2.13846114572058_wp, -0.99012126457352_wp, 0.93647189687052_wp, & + & 0.09330150731888_wp, -2.75648066796634_wp, -3.70294675694565_wp, & + & -1.52684105316140_wp, -2.44981814860506_wp, -1.02727325811774_wp, & + & -0.45240334635443_wp, 5.86105501765814_wp, 0.30815308772432_wp, & + & -3.95419048213910_wp, -5.52061943693205_wp, -0.31702321028260_wp, & + & 2.68706169520082_wp, -0.13577304635533_wp, -3.57041492458512_wp, & + & -3.79914135008731_wp, 2.06429808651079_wp, -0.77285245656187_wp, & + & 0.89693752015341_wp, 4.58640300917890_wp, 3.09718012019731_wp, & + & 2.76317093138142_wp, -0.62928000132252_wp, 3.08807601371151_wp, & + & 1.00075543259914_wp, -3.11885279872042_wp, 1.08659460804098_wp, & + & 0.86969979951508_wp, 4.43363816376984_wp, 1.02355776570620_wp, & + & 4.05637089597643_wp, -1.52300699610852_wp, -0.29218485610105_wp],& + & shape(xyz)) + integer, parameter :: uhf = 1 + call init(mol, sym, xyz, uhf=uhf) +end subroutine mindless06 - subroutine mindless07(mol) - type(TMolecule), intent(out) :: mol - integer, parameter :: nat = 16 - character(len=*), parameter :: sym(nat) = [character(len=4) ::& - & "C", "H", "B", "H", "H", "Cl", "F", "N", "C", "H", "S", "H", "H", "O", "F", "Mg"] - real(wp), parameter :: xyz(3, nat) = reshape([& - & -3.75104222741336_wp, -5.81308736205268_wp, -1.22507366840233_wp, & - & -1.45226572768296_wp, -3.01878767879831_wp, 2.38723142561073_wp, & - & -1.99423317853240_wp, -3.52953889999752_wp, -1.30301724065129_wp, & - & -4.33750965171233_wp, -6.65936981001909_wp, 0.55979831484564_wp, & - & -4.51833920602637_wp, -6.72398616322561_wp, -2.90031439001886_wp, & - & -1.25657105633503_wp, -2.39389339457851_wp, -4.58765484136593_wp, & - & -0.14864209579028_wp, 4.40065007854051_wp, 1.35717716022989_wp, & - & -0.91662354168326_wp, -2.22680612180354_wp, 0.71122632634918_wp, & - & 1.83282041695179_wp, 5.36061635978157_wp, 3.22095765094686_wp, & - & 0.66518416413161_wp, 6.30980889882630_wp, 4.62705414435961_wp, & - & 3.68701623423530_wp, 2.79957532381681_wp, 4.21336212424745_wp, & - & 1.69373321407504_wp, 0.01030275402386_wp, -3.74820290941150_wp, & - & 3.35791986589808_wp, 2.52513229318111_wp, -3.46078430541625_wp, & - & 2.79199182665654_wp, 1.01759578021447_wp, -2.59243571461852_wp, & - & 3.05358934464082_wp, 7.15252337445235_wp, 1.82164153773112_wp, & - & 1.29297161858681_wp, 0.78926456763834_wp, 0.91903438556425_wp],& - & shape(xyz)) - integer, parameter :: uhf = 1 - call init(mol, sym, xyz, uhf=uhf) - end subroutine mindless07 +subroutine mindless07(mol) + type(TMolecule), intent(out) :: mol + integer, parameter :: nat = 16 + character(len=*), parameter :: sym(nat) = [character(len=4) ::& + & "C", "H", "B", "H", "H", "Cl", "F", "N", "C", "H", "S", "H", "H", "O", "F", "Mg"] + real(wp), parameter :: xyz(3, nat) = reshape([& + & -3.75104222741336_wp, -5.81308736205268_wp, -1.22507366840233_wp, & + & -1.45226572768296_wp, -3.01878767879831_wp, 2.38723142561073_wp, & + & -1.99423317853240_wp, -3.52953889999752_wp, -1.30301724065129_wp, & + & -4.33750965171233_wp, -6.65936981001909_wp, 0.55979831484564_wp, & + & -4.51833920602637_wp, -6.72398616322561_wp, -2.90031439001886_wp, & + & -1.25657105633503_wp, -2.39389339457851_wp, -4.58765484136593_wp, & + & -0.14864209579028_wp, 4.40065007854051_wp, 1.35717716022989_wp, & + & -0.91662354168326_wp, -2.22680612180354_wp, 0.71122632634918_wp, & + & 1.83282041695179_wp, 5.36061635978157_wp, 3.22095765094686_wp, & + & 0.66518416413161_wp, 6.30980889882630_wp, 4.62705414435961_wp, & + & 3.68701623423530_wp, 2.79957532381681_wp, 4.21336212424745_wp, & + & 1.69373321407504_wp, 0.01030275402386_wp, -3.74820290941150_wp, & + & 3.35791986589808_wp, 2.52513229318111_wp, -3.46078430541625_wp, & + & 2.79199182665654_wp, 1.01759578021447_wp, -2.59243571461852_wp, & + & 3.05358934464082_wp, 7.15252337445235_wp, 1.82164153773112_wp, & + & 1.29297161858681_wp, 0.78926456763834_wp, 0.91903438556425_wp],& + & shape(xyz)) + integer, parameter :: uhf = 1 + call init(mol, sym, xyz, uhf=uhf) +end subroutine mindless07 - subroutine mindless08(mol) - type(TMolecule), intent(out) :: mol - integer, parameter :: nat = 16 - character(len=*), parameter :: sym(nat) = [character(len=4) ::& - & "C", "O", "B", "F", "H", "Al", "H", "H", "O", "B", "Be", "C", "H", "H", "B", "F"] - real(wp), parameter :: xyz(3, nat) = reshape([& - & -1.27823293129313_wp, 0.06442674490989_wp, 2.76980447300615_wp, & - & 2.05039033278229_wp, 0.64690940303039_wp, -0.29571013189632_wp, & - & -0.07388472989895_wp, 2.46033979750309_wp, -1.30590420482375_wp, & - & 1.10019432741349_wp, 4.43501067437330_wp, -2.64796515354449_wp, & - & -1.89008873387150_wp, 0.02064696008121_wp, 4.74727599156952_wp, & - & 0.81013963557610_wp, 1.41165582964016_wp, -6.35835508532445_wp, & - & 2.51638337449170_wp, 1.74086425451198_wp, 3.45340860505386_wp, & - & 2.62048878651566_wp, -1.58024532804571_wp, 2.87415150030394_wp, & - & -0.92472602392464_wp, -3.37659091509259_wp, -0.68138826965952_wp, & - & -2.19962829538645_wp, -2.53092502025386_wp, 1.35654623095955_wp, & - & 0.92594749614406_wp, -1.61669775704536_wp, -1.93872059141561_wp, & - & 1.63141903847248_wp, 0.18081362275364_wp, 2.42899361614054_wp, & - & -3.96336280784845_wp, -3.68611886004249_wp, 2.18920954455515_wp, & - & -1.17097381446263_wp, 1.08303722364990_wp, -3.04753977323348_wp, & - & -2.18263847972349_wp, 2.31604957286801_wp, 1.11461091308323_wp, & - & 2.02857282501340_wp, -1.56917620284149_wp, -4.65841766477431_wp],& - & shape(xyz)) - integer, parameter :: uhf = 1 - call init(mol, sym, xyz, uhf=uhf) - end subroutine mindless08 +subroutine mindless08(mol) + type(TMolecule), intent(out) :: mol + integer, parameter :: nat = 16 + character(len=*), parameter :: sym(nat) = [character(len=4) ::& + & "C", "O", "B", "F", "H", "Al", "H", "H", "O", "B", "Be", "C", "H", "H", "B", "F"] + real(wp), parameter :: xyz(3, nat) = reshape([& + & -1.27823293129313_wp, 0.06442674490989_wp, 2.76980447300615_wp, & + & 2.05039033278229_wp, 0.64690940303039_wp, -0.29571013189632_wp, & + & -0.07388472989895_wp, 2.46033979750309_wp, -1.30590420482375_wp, & + & 1.10019432741349_wp, 4.43501067437330_wp, -2.64796515354449_wp, & + & -1.89008873387150_wp, 0.02064696008121_wp, 4.74727599156952_wp, & + & 0.81013963557610_wp, 1.41165582964016_wp, -6.35835508532445_wp, & + & 2.51638337449170_wp, 1.74086425451198_wp, 3.45340860505386_wp, & + & 2.62048878651566_wp, -1.58024532804571_wp, 2.87415150030394_wp, & + & -0.92472602392464_wp, -3.37659091509259_wp, -0.68138826965952_wp, & + & -2.19962829538645_wp, -2.53092502025386_wp, 1.35654623095955_wp, & + & 0.92594749614406_wp, -1.61669775704536_wp, -1.93872059141561_wp, & + & 1.63141903847248_wp, 0.18081362275364_wp, 2.42899361614054_wp, & + & -3.96336280784845_wp, -3.68611886004249_wp, 2.18920954455515_wp, & + & -1.17097381446263_wp, 1.08303722364990_wp, -3.04753977323348_wp, & + & -2.18263847972349_wp, 2.31604957286801_wp, 1.11461091308323_wp, & + & 2.02857282501340_wp, -1.56917620284149_wp, -4.65841766477431_wp],& + & shape(xyz)) + integer, parameter :: uhf = 1 + call init(mol, sym, xyz, uhf=uhf) +end subroutine mindless08 - subroutine mindless09(mol) - type(TMolecule), intent(out) :: mol - integer, parameter :: nat = 16 - character(len=*), parameter :: sym(nat) = [character(len=4) ::& - & "H", "H", "H", "H", "Li", "H", "C", "B", "H", "H", "Si", "H", "Cl", "F", "H", "B"] - real(wp), parameter :: xyz(3, nat) = reshape([& - & 3.97360649552839_wp, 1.71723751297383_wp, -0.51862929250676_wp, & - & 0.16903666216522_wp, 1.73154352333176_wp, -0.40099024352959_wp, & - & -3.94463844105182_wp, -1.24346369608005_wp, 0.09565841726334_wp, & - & 2.21647168119803_wp, 4.10625979391554_wp, 2.61391340002321_wp, & - & -0.04488993380842_wp, -2.16288302687041_wp, 4.48488595610432_wp, & - & 3.52287141817194_wp, -0.90500888687059_wp, -5.00916337263077_wp, & - & 1.95336082370762_wp, -0.83849036872324_wp, -3.65515970516029_wp, & - & 2.05706981818495_wp, 1.70095588601056_wp, -2.06303335904159_wp, & - & -6.40097100472159_wp, -1.71072935987273_wp, 3.14621771036234_wp, & - & 2.04751538182937_wp, -2.55691868000982_wp, -2.49926722310562_wp, & - & 2.03251078714394_wp, 1.35094356516468_wp, 2.02150308748654_wp, & - & 0.20477572129201_wp, -0.93291693232462_wp, -4.76431390827476_wp, & - & -2.67673272939098_wp, 1.40764602033672_wp, 4.10347165469140_wp, & - & -2.75901984658887_wp, -3.73954809548334_wp, 3.19373273207227_wp, & - & 1.96938102642596_wp, 3.74070925169244_wp, -3.03185101883736_wp, & - & -4.32034786008576_wp, -1.66533650719069_wp, 2.28302516508337_wp],& - & shape(xyz)) - call init(mol, sym, xyz) - end subroutine mindless09 +subroutine mindless09(mol) + type(TMolecule), intent(out) :: mol + integer, parameter :: nat = 16 + character(len=*), parameter :: sym(nat) = [character(len=4) ::& + & "H", "H", "H", "H", "Li", "H", "C", "B", "H", "H", "Si", "H", "Cl", "F", "H", "B"] + real(wp), parameter :: xyz(3, nat) = reshape([& + & 3.97360649552839_wp, 1.71723751297383_wp, -0.51862929250676_wp, & + & 0.16903666216522_wp, 1.73154352333176_wp, -0.40099024352959_wp, & + & -3.94463844105182_wp, -1.24346369608005_wp, 0.09565841726334_wp, & + & 2.21647168119803_wp, 4.10625979391554_wp, 2.61391340002321_wp, & + & -0.04488993380842_wp, -2.16288302687041_wp, 4.48488595610432_wp, & + & 3.52287141817194_wp, -0.90500888687059_wp, -5.00916337263077_wp, & + & 1.95336082370762_wp, -0.83849036872324_wp, -3.65515970516029_wp, & + & 2.05706981818495_wp, 1.70095588601056_wp, -2.06303335904159_wp, & + & -6.40097100472159_wp, -1.71072935987273_wp, 3.14621771036234_wp, & + & 2.04751538182937_wp, -2.55691868000982_wp, -2.49926722310562_wp, & + & 2.03251078714394_wp, 1.35094356516468_wp, 2.02150308748654_wp, & + & 0.20477572129201_wp, -0.93291693232462_wp, -4.76431390827476_wp, & + & -2.67673272939098_wp, 1.40764602033672_wp, 4.10347165469140_wp, & + & -2.75901984658887_wp, -3.73954809548334_wp, 3.19373273207227_wp, & + & 1.96938102642596_wp, 3.74070925169244_wp, -3.03185101883736_wp, & + & -4.32034786008576_wp, -1.66533650719069_wp, 2.28302516508337_wp],& + & shape(xyz)) + call init(mol, sym, xyz) +end subroutine mindless09 - subroutine mindless10(mol) - type(TMolecule), intent(out) :: mol - integer, parameter :: nat = 16 - character(len=*), parameter :: sym(nat) = [character(len=4) ::& - & "H", "Si", "H", "Cl", "C", "H", "F", "H", "C", "N", "B", "H", "Mg", "C", "H", "H"] - real(wp), parameter :: xyz(3, nat) = reshape([& - & 3.57062307661218_wp, -1.68792229443234_wp, 2.78939425857465_wp, & - & -2.08994110527129_wp, 3.25317728228563_wp, -0.42147881550833_wp, & - & 2.13532981939105_wp, -1.71356933061236_wp, -2.49234593851880_wp, & - & -2.46885241522113_wp, -4.41076598859264_wp, -0.58746410797603_wp, & - & 3.86605901148259_wp, -0.50808683490216_wp, 1.10929274542242_wp, & - & -4.57284898019279_wp, -1.54920337824862_wp, -2.63711913350102_wp, & - & -4.99945502320431_wp, 0.09990896897876_wp, -3.20268495970371_wp, & - & 1.63618508154720_wp, 2.66791559582643_wp, -3.16904643876699_wp, & - & -2.28445827511587_wp, 0.42792856662334_wp, 2.04433546457507_wp, & - & 0.78486183614848_wp, 1.96692225005484_wp, -1.58921219981020_wp, & - & -0.92003258313224_wp, -1.56076484060483_wp, 0.46494611026243_wp, & - & -1.07970143095156_wp, 1.19037461384346_wp, 3.56880222429743_wp, & - & 3.27327901654007_wp, 3.47628642644825_wp, 1.85050408639730_wp, & - & 1.64922592697103_wp, -0.66726875777723_wp, -0.77306391492380_wp, & - & 5.67004330685832_wp, -1.05218123504276_wp, 0.25282456342591_wp, & - & -4.17031726246173_wp, 0.06724895615223_wp, 2.79231605575371_wp],& - & shape(xyz)) - integer, parameter :: uhf = 1 - call init(mol, sym, xyz, uhf=uhf) - end subroutine mindless10 +subroutine mindless10(mol) + type(TMolecule), intent(out) :: mol + integer, parameter :: nat = 16 + character(len=*), parameter :: sym(nat) = [character(len=4) ::& + & "H", "Si", "H", "Cl", "C", "H", "F", "H", "C", "N", "B", "H", "Mg", "C", "H", "H"] + real(wp), parameter :: xyz(3, nat) = reshape([& + & 3.57062307661218_wp, -1.68792229443234_wp, 2.78939425857465_wp, & + & -2.08994110527129_wp, 3.25317728228563_wp, -0.42147881550833_wp, & + & 2.13532981939105_wp, -1.71356933061236_wp, -2.49234593851880_wp, & + & -2.46885241522113_wp, -4.41076598859264_wp, -0.58746410797603_wp, & + & 3.86605901148259_wp, -0.50808683490216_wp, 1.10929274542242_wp, & + & -4.57284898019279_wp, -1.54920337824862_wp, -2.63711913350102_wp, & + & -4.99945502320431_wp, 0.09990896897876_wp, -3.20268495970371_wp, & + & 1.63618508154720_wp, 2.66791559582643_wp, -3.16904643876699_wp, & + & -2.28445827511587_wp, 0.42792856662334_wp, 2.04433546457507_wp, & + & 0.78486183614848_wp, 1.96692225005484_wp, -1.58921219981020_wp, & + & -0.92003258313224_wp, -1.56076484060483_wp, 0.46494611026243_wp, & + & -1.07970143095156_wp, 1.19037461384346_wp, 3.56880222429743_wp, & + & 3.27327901654007_wp, 3.47628642644825_wp, 1.85050408639730_wp, & + & 1.64922592697103_wp, -0.66726875777723_wp, -0.77306391492380_wp, & + & 5.67004330685832_wp, -1.05218123504276_wp, 0.25282456342591_wp, & + & -4.17031726246173_wp, 0.06724895615223_wp, 2.79231605575371_wp],& + & shape(xyz)) + integer, parameter :: uhf = 1 + call init(mol, sym, xyz, uhf=uhf) +end subroutine mindless10 - subroutine caffeine(mol) - type(TMolecule), intent(inout) :: mol - integer, parameter :: nat = 24 - integer, parameter :: at(nat) = & - [6, 7, 6, 7, 6, 6, 6, 8, 7, 6, 8, 7, 6, 6, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1] - real(wp), parameter :: xyz(3, nat) = reshape([& - & 2.02799738646442_wp, 0.09231312124713_wp, -0.14310895950963_wp, & - & 4.75011007621000_wp, 0.02373496014051_wp, -0.14324124033844_wp, & - & 6.33434307654413_wp, 2.07098865582721_wp, -0.14235306905930_wp, & - & 8.72860718071825_wp, 1.38002919517619_wp, -0.14265542523943_wp, & - & 8.65318821103610_wp, -1.19324866489847_wp, -0.14231527453678_wp, & - & 6.23857175648671_wp, -2.08353643730276_wp, -0.14218299370797_wp, & - & 5.63266886875962_wp, -4.69950321056008_wp, -0.13940509630299_wp, & - & 3.44931709749015_wp, -5.48092386085491_wp, -0.14318454855466_wp, & - & 7.77508917214346_wp, -6.24427872938674_wp, -0.13107140408805_wp, & - & 10.30229550927022_wp, -5.39739796609292_wp, -0.13672168520430_wp, & - & 12.07410272485492_wp, -6.91573621641911_wp, -0.13666499342053_wp, & - & 10.70038521493902_wp, -2.79078533715849_wp, -0.14148379504141_wp, & - & 13.24597858727017_wp, -1.76969072232377_wp, -0.14218299370797_wp, & - & 7.40891694074004_wp, -8.95905928176407_wp, -0.11636933482904_wp, & - & 1.38702118184179_wp, 2.05575746325296_wp, -0.14178615122154_wp, & - & 1.34622199478497_wp, -0.86356704498496_wp, 1.55590600570783_wp, & - & 1.34624089204623_wp, -0.86133716815647_wp, -1.84340893849267_wp, & - & 5.65596919189118_wp, 4.00172183859480_wp, -0.14131371969009_wp, & - & 14.67430918222276_wp, -3.26230980007732_wp, -0.14344911021228_wp, & - & 13.50897177220290_wp, -0.60815166181684_wp, 1.54898960808727_wp, & - & 13.50780014200488_wp, -0.60614855212345_wp, -1.83214617078268_wp, & - & 5.41408424778406_wp, -9.49239668625902_wp, -0.11022772492007_wp, & - & 8.31919801555568_wp, -9.74947502841788_wp, 1.56539243085954_wp, & - & 8.31511620712388_wp, -9.76854236502758_wp, -1.79108242206824_wp],& - & shape(xyz)) - call init(mol, at, xyz) - end subroutine caffeine +subroutine caffeine(mol) + type(TMolecule), intent(inout) :: mol + integer, parameter :: nat = 24 + integer, parameter :: at(nat) = & + [6, 7, 6, 7, 6, 6, 6, 8, 7, 6, 8, 7, 6, 6, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1] + real(wp), parameter :: xyz(3, nat) = reshape([& + & 2.02799738646442_wp, 0.09231312124713_wp, -0.14310895950963_wp, & + & 4.75011007621000_wp, 0.02373496014051_wp, -0.14324124033844_wp, & + & 6.33434307654413_wp, 2.07098865582721_wp, -0.14235306905930_wp, & + & 8.72860718071825_wp, 1.38002919517619_wp, -0.14265542523943_wp, & + & 8.65318821103610_wp, -1.19324866489847_wp, -0.14231527453678_wp, & + & 6.23857175648671_wp, -2.08353643730276_wp, -0.14218299370797_wp, & + & 5.63266886875962_wp, -4.69950321056008_wp, -0.13940509630299_wp, & + & 3.44931709749015_wp, -5.48092386085491_wp, -0.14318454855466_wp, & + & 7.77508917214346_wp, -6.24427872938674_wp, -0.13107140408805_wp, & + & 10.30229550927022_wp, -5.39739796609292_wp, -0.13672168520430_wp, & + & 12.07410272485492_wp, -6.91573621641911_wp, -0.13666499342053_wp, & + & 10.70038521493902_wp, -2.79078533715849_wp, -0.14148379504141_wp, & + & 13.24597858727017_wp, -1.76969072232377_wp, -0.14218299370797_wp, & + & 7.40891694074004_wp, -8.95905928176407_wp, -0.11636933482904_wp, & + & 1.38702118184179_wp, 2.05575746325296_wp, -0.14178615122154_wp, & + & 1.34622199478497_wp, -0.86356704498496_wp, 1.55590600570783_wp, & + & 1.34624089204623_wp, -0.86133716815647_wp, -1.84340893849267_wp, & + & 5.65596919189118_wp, 4.00172183859480_wp, -0.14131371969009_wp, & + & 14.67430918222276_wp, -3.26230980007732_wp, -0.14344911021228_wp, & + & 13.50897177220290_wp, -0.60815166181684_wp, 1.54898960808727_wp, & + & 13.50780014200488_wp, -0.60614855212345_wp, -1.83214617078268_wp, & + & 5.41408424778406_wp, -9.49239668625902_wp, -0.11022772492007_wp, & + & 8.31919801555568_wp, -9.74947502841788_wp, 1.56539243085954_wp, & + & 8.31511620712388_wp, -9.76854236502758_wp, -1.79108242206824_wp],& + & shape(xyz)) + call init(mol, at, xyz) +end subroutine caffeine - subroutine rivaroxaban(mol) - type(TMolecule), intent(out) :: mol - integer, parameter :: nat = 47 - character(len=*), parameter :: sym(nat) = [character(len=4) ::& - & "Cl", "C", "C", "C", "C", "S", "C", "O", "N", "C", "C", "C", "N", & - & "C", "O", "O", "C", "C", "C", "C", "C", "C", "H", "H", "N", "C", & - & "O", "C", "O", "C", "C", "H", "H", "H", "H", "H", "H", "H", "H", & - & "H", "H", "H", "H", "H", "H", "H", "H"] - real(wp), parameter :: xyz(3, nat) = reshape([& - & 19.59759192978171_wp, 0.07558903797189_wp, 0.17650040366436_wp, & - & 16.38864829528011_wp, 0.34638676650618_wp, 0.52326511536040_wp, & - & 15.01935287241935_wp, 2.48858010262950_wp, 1.08300194154223_wp, & - & 12.37657113232719_wp, 1.99214909574913_wp, 1.21792837432206_wp, & - & 11.89828149456006_wp, -0.47337635029895_wp, 0.75683524269354_wp, & - & 14.48985166142627_wp, -2.24896285225862_wp, 0.16251643163956_wp, & - & 9.42330741876550_wp, -1.73344561329034_wp, 0.72282017560619_wp, & - & 9.18671372991349_wp, -3.99714832795347_wp, 0.22997964802947_wp, & - & 7.32779031358982_wp, -0.20068889581536_wp, 1.22548727811924_wp, & - & 4.79045528146844_wp, -1.14725262381834_wp, 1.20205467634796_wp, & - & 3.61995902847375_wp, -0.92237523585197_wp, -1.41634959899826_wp, & - & 0.93711509825649_wp, -1.90616656505610_wp, -1.53974870348737_wp, & - & -0.56332730548550_wp, 0.34449704055688_wp, -1.27065172830745_wp, & - & 0.93900482420579_wp, 2.46117907636470_wp, -1.70339897069651_wp, & - & 0.33542635600026_wp, 4.68803213501653_wp, -1.83643567752704_wp, & - & 3.40282951689950_wp, 1.70283205291172_wp, -2.05583286024044_wp, & - & -3.21669151089372_wp, 0.28364786498951_wp, -0.82637715762767_wp, & - & -4.59921501539957_wp, 2.52750845718503_wp, -0.79274003573018_wp, & - & -7.19834408606296_wp, 2.46798208978216_wp, -0.35753614960703_wp, & - & -8.40304437873993_wp, 0.16459513018379_wp, 0.04176294347947_wp, & - & -7.03242614771466_wp, -2.07983237979652_wp, 0.01020452012620_wp, & - & -4.43329707705127_wp, -2.01992806720379_wp, -0.42481039340201_wp, & - & -3.43608869360713_wp, -3.81176621232742_wp, -0.42821190011075_wp, & - & -7.88053515375925_wp, -3.90322894827340_wp, 0.40799183245327_wp, & - & -11.09250234977973_wp, 0.10299006423670_wp, 0.49246258238685_wp, & - & -12.58292920599045_wp, -1.97381875404094_wp, -0.22922375764975_wp, & - & -11.87069149570033_wp, -3.81573463682094_wp, -1.46378172032562_wp, & - & -15.30999272342126_wp, -1.91826081113160_wp, 0.69938757383490_wp, & - & -16.35557809116741_wp, 0.48244703485558_wp, 1.17408673229836_wp, & - & -14.75441329432788_wp, 1.88594649739862_wp, 2.80359741837735_wp, & - & -12.32063524422799_wp, 2.42243969440410_wp, 1.39499569577121_wp, & - & -11.05584166636337_wp, 3.45498595310010_wp, 2.66734817743302_wp, & - & -12.72635940554211_wp, 3.57517252347540_wp, -0.27873457752134_wp, & - & -15.70872489872297_wp, 3.65586382151040_wp, 3.28698931620758_wp, & - & -14.42276639022622_wp, 0.83677065034881_wp, 4.55971974305925_wp, & - & -16.48785890761821_wp, -2.82627412976892_wp, -0.74020565433972_wp, & - & -15.42526600632839_wp, -3.07250542096234_wp, 2.41639257136635_wp, & - & -8.20934746893697_wp, 4.25282824889339_wp, -0.39249607966903_wp, & - & -3.77794011783500_wp, 4.37395968224334_wp, -1.09793077654168_wp, & - & 0.56710675738409_wp, -3.30550863051069_wp, -0.06443965487104_wp, & - & 0.53630422441055_wp, -2.72328406553222_wp, -3.40018390057048_wp, & - & 4.80991945874621_wp, -1.85930136151353_wp, -2.82873077350300_wp, & - & 4.78818761032929_wp, -3.11861473412520_wp, 1.83303417081830_wp, & - & 3.73598820176060_wp, -0.02305465658143_wp, 2.58457818085380_wp, & - & 7.55210078377140_wp, 1.66465958873592_wp, 1.59984198867502_wp, & - & 10.99518146339092_wp, 3.43911225512600_wp, 1.63669164468632_wp, & - & 15.86217064580591_wp, 4.32879523205513_wp, 1.38290144969570_wp],& - & shape(xyz)) - call init(mol, sym, xyz) - end subroutine rivaroxaban +subroutine rivaroxaban(mol) + type(TMolecule), intent(out) :: mol + integer, parameter :: nat = 47 + character(len=*), parameter :: sym(nat) = [character(len=4) ::& + & "Cl", "C", "C", "C", "C", "S", "C", "O", "N", "C", "C", "C", "N", & + & "C", "O", "O", "C", "C", "C", "C", "C", "C", "H", "H", "N", "C", & + & "O", "C", "O", "C", "C", "H", "H", "H", "H", "H", "H", "H", "H", & + & "H", "H", "H", "H", "H", "H", "H", "H"] + real(wp), parameter :: xyz(3, nat) = reshape([& + & 19.59759192978171_wp, 0.07558903797189_wp, 0.17650040366436_wp, & + & 16.38864829528011_wp, 0.34638676650618_wp, 0.52326511536040_wp, & + & 15.01935287241935_wp, 2.48858010262950_wp, 1.08300194154223_wp, & + & 12.37657113232719_wp, 1.99214909574913_wp, 1.21792837432206_wp, & + & 11.89828149456006_wp, -0.47337635029895_wp, 0.75683524269354_wp, & + & 14.48985166142627_wp, -2.24896285225862_wp, 0.16251643163956_wp, & + & 9.42330741876550_wp, -1.73344561329034_wp, 0.72282017560619_wp, & + & 9.18671372991349_wp, -3.99714832795347_wp, 0.22997964802947_wp, & + & 7.32779031358982_wp, -0.20068889581536_wp, 1.22548727811924_wp, & + & 4.79045528146844_wp, -1.14725262381834_wp, 1.20205467634796_wp, & + & 3.61995902847375_wp, -0.92237523585197_wp, -1.41634959899826_wp, & + & 0.93711509825649_wp, -1.90616656505610_wp, -1.53974870348737_wp, & + & -0.56332730548550_wp, 0.34449704055688_wp, -1.27065172830745_wp, & + & 0.93900482420579_wp, 2.46117907636470_wp, -1.70339897069651_wp, & + & 0.33542635600026_wp, 4.68803213501653_wp, -1.83643567752704_wp, & + & 3.40282951689950_wp, 1.70283205291172_wp, -2.05583286024044_wp, & + & -3.21669151089372_wp, 0.28364786498951_wp, -0.82637715762767_wp, & + & -4.59921501539957_wp, 2.52750845718503_wp, -0.79274003573018_wp, & + & -7.19834408606296_wp, 2.46798208978216_wp, -0.35753614960703_wp, & + & -8.40304437873993_wp, 0.16459513018379_wp, 0.04176294347947_wp, & + & -7.03242614771466_wp, -2.07983237979652_wp, 0.01020452012620_wp, & + & -4.43329707705127_wp, -2.01992806720379_wp, -0.42481039340201_wp, & + & -3.43608869360713_wp, -3.81176621232742_wp, -0.42821190011075_wp, & + & -7.88053515375925_wp, -3.90322894827340_wp, 0.40799183245327_wp, & + & -11.09250234977973_wp, 0.10299006423670_wp, 0.49246258238685_wp, & + & -12.58292920599045_wp, -1.97381875404094_wp, -0.22922375764975_wp, & + & -11.87069149570033_wp, -3.81573463682094_wp, -1.46378172032562_wp, & + & -15.30999272342126_wp, -1.91826081113160_wp, 0.69938757383490_wp, & + & -16.35557809116741_wp, 0.48244703485558_wp, 1.17408673229836_wp, & + & -14.75441329432788_wp, 1.88594649739862_wp, 2.80359741837735_wp, & + & -12.32063524422799_wp, 2.42243969440410_wp, 1.39499569577121_wp, & + & -11.05584166636337_wp, 3.45498595310010_wp, 2.66734817743302_wp, & + & -12.72635940554211_wp, 3.57517252347540_wp, -0.27873457752134_wp, & + & -15.70872489872297_wp, 3.65586382151040_wp, 3.28698931620758_wp, & + & -14.42276639022622_wp, 0.83677065034881_wp, 4.55971974305925_wp, & + & -16.48785890761821_wp, -2.82627412976892_wp, -0.74020565433972_wp, & + & -15.42526600632839_wp, -3.07250542096234_wp, 2.41639257136635_wp, & + & -8.20934746893697_wp, 4.25282824889339_wp, -0.39249607966903_wp, & + & -3.77794011783500_wp, 4.37395968224334_wp, -1.09793077654168_wp, & + & 0.56710675738409_wp, -3.30550863051069_wp, -0.06443965487104_wp, & + & 0.53630422441055_wp, -2.72328406553222_wp, -3.40018390057048_wp, & + & 4.80991945874621_wp, -1.85930136151353_wp, -2.82873077350300_wp, & + & 4.78818761032929_wp, -3.11861473412520_wp, 1.83303417081830_wp, & + & 3.73598820176060_wp, -0.02305465658143_wp, 2.58457818085380_wp, & + & 7.55210078377140_wp, 1.66465958873592_wp, 1.59984198867502_wp, & + & 10.99518146339092_wp, 3.43911225512600_wp, 1.63669164468632_wp, & + & 15.86217064580591_wp, 4.32879523205513_wp, 1.38290144969570_wp],& + & shape(xyz)) + call init(mol, sym, xyz) +end subroutine rivaroxaban - subroutine grubbs(mol) - type(TMolecule), intent(inout) :: mol - integer, parameter :: nat = 75 - character(len=*), parameter :: sym(nat) = [character(len=4) ::& - & "Ru", "C", "C", "C", "C", "C", "C", "C", "O", "C", "C", "H", "H", & - & "H", "C", "H", "H", "H", "H", "H", "H", "H", "H", "H", "C", "N", & - & "C", "C", "C", "C", "C", "C", "C", "H", "H", "H", "H", "C", "H", & - & "H", "H", "H", "C", "H", "H", "H", "C", "C", "N", "C", "C", "C", & - & "C", "C", "C", "C", "H", "H", "H", "H", "C", "H", "H", "H", "H", & - & "C", "H", "H", "H", "H", "H", "H", "H", "Cl", "Cl"] - real(wp), parameter :: xyz(3, nat) = reshape([& - & -4.48876242338909_wp, -2.09410736961751_wp, 6.48025767395976_wp, & - & -3.39542935008205_wp, -1.00934609321648_wp, 3.37297562635250_wp, & - & -0.89096799057465_wp, -1.65719139178430_wp, 2.52794687360526_wp, & - & -0.00187838759360_wp, -1.02726825411961_wp, 0.11235554604142_wp, & - & 2.39977999054608_wp, -1.73257067017581_wp, -0.66001135422939_wp, & - & 3.94523944585223_wp, -3.08713189980991_wp, 0.98469839765979_wp, & - & 3.13084315074310_wp, -3.73573308875744_wp, 3.40383674083047_wp, & - & 0.72574925082760_wp, -3.01450028294867_wp, 4.16236328824863_wp, & - & -0.34548725695431_wp, -3.51939537235595_wp, 6.43739490997780_wp, & - & 1.10498701323636_wp, -4.64071528697208_wp, 8.49906135422373_wp, & - & -0.81899588806972_wp, -5.50999300310070_wp, 10.42067453918938_wp, & - & -2.16671442004141_wp, -6.83194323202777_wp, 9.58791577703093_wp, & - & 0.14674477886673_wp, -6.44058098792832_wp, 11.99173033247876_wp, & - & -1.86211705317798_wp, -3.89003299196946_wp, 11.18088861188026_wp, & - & 2.94345036670699_wp, -2.71461211315089_wp, 9.54109403718520_wp, & - & 4.25175488455419_wp, -2.02822207439526_wp, 8.10113798162831_wp, & - & 1.90191279194423_wp, -1.09894933882835_wp, 10.29213915957009_wp, & - & 4.05380231191340_wp, -3.56092776926960_wp, 11.06322671537322_wp, & - & 2.09442106412509_wp, -6.28009790141020_wp, 7.69876997360015_wp, & - & 4.36447703742976_wp, -4.78998851915897_wp, 4.65115224339005_wp, & - & 5.82373853328467_wp, -3.65349977434782_wp, 0.38695351345974_wp, & - & 3.07317627367435_wp, -1.24186175346991_wp, -2.53223088233232_wp, & - & -1.25251791809799_wp, 0.01729855133987_wp, -1.13979009604457_wp, & - & -4.50256120227086_wp, 0.08700676215754_wp, 2.02024932061518_wp, & - & -7.98117439891502_wp, -0.91146395822073_wp, 6.61491387592883_wp, & - & -9.54120931046810_wp, 0.23196386027623_wp, 4.93017972843353_wp, & - & -8.81626697262086_wp, 1.20094351748977_wp, 2.52737617636858_wp, & - & -9.12263312297282_wp, -0.33655074294009_wp, 0.39778731232706_wp, & - & -8.32022713901198_wp, 0.60170386006383_wp, -1.92819510044706_wp, & - & -7.24034702473799_wp, 2.99722440832019_wp, -2.16074666549353_wp, & - & -6.95751930081047_wp, 4.46636539143802_wp, 0.00913871469080_wp, & - & -7.72222903153473_wp, 3.60494893525848_wp, 2.37913095509811_wp, & - & -7.20124859484703_wp, 5.10159865902023_wp, 4.72196405416212_wp, & - & -6.40848210295356_wp, 6.94912135869179_wp, 4.26394361692715_wp, & - & -8.90386710872648_wp, 5.41338265366883_wp, 5.85428028407721_wp, & - & -5.85075405545582_wp, 4.11205689375239_wp, 5.94471689883273_wp, & - & -6.07723204130125_wp, 6.31818721764424_wp, -0.13610562177218_wp, & - & -6.41560636978241_wp, 3.96790859834000_wp, -4.68988595617280_wp, & - & -5.00475020411875_wp, 5.46289536326637_wp, -4.51108764575409_wp, & - & -5.61432855221330_wp, 2.46525899468923_wp, -5.85859641814541_wp, & - & -8.01116812918227_wp, 4.75888551975949_wp, -5.74517506666859_wp, & - & -8.51402987346811_wp, -0.58379681696829_wp, -3.59647918355373_wp, & - & -10.11190843688181_wp, -2.97112351350850_wp, 0.67258748042197_wp, & - & -10.35742352194046_wp, -3.87297632555110_wp, -1.16520313061071_wp, & - & -11.93170696715124_wp, -3.01882775537256_wp, 1.65559268363119_wp, & - & -8.80853799348823_wp, -4.13077840873208_wp, 1.79194019032488_wp, & - & -12.00826165508321_wp, 0.89370998292708_wp, 6.00001216983511_wp, & - & -11.99803445824562_wp, -0.48821258872689_wp, 8.52708221059990_wp, & - & -9.34971393139607_wp, -1.22700094860463_wp, 8.78345188151131_wp, & - & -8.45101507196284_wp, -2.63174385082231_wp, 10.90901184982892_wp, & - & -7.37601611981588_wp, -1.32890819987238_wp, 12.95669810150194_wp, & - & -6.33567852103093_wp, -2.74890119050089_wp, 14.91661225200796_wp, & - & -6.40297544153730_wp, -5.38068850502004_wp, 14.91783301497120_wp, & - & -7.66406515654131_wp, -6.60173870661033_wp, 12.95345155232105_wp, & - & -8.73996550796608_wp, -5.27286452180504_wp, 10.95168753094190_wp, & - & -10.30065615442357_wp, -6.64280056176261_wp, 9.02763659950165_wp, & - & -10.40423770288240_wp, -5.65022200689425_wp, 7.22532748289297_wp, & - & -9.53138840470961_wp, -8.51497473644276_wp, 8.63796754985277_wp, & - & -12.23007579728577_wp, -6.89514322667607_wp, 9.74487452465361_wp, & - & -7.82480146633663_wp, -8.65107468903709_wp, 12.97505111992152_wp, & - & -5.13310794949881_wp, -6.86601499089360_wp, 16.96523202829993_wp, & - & -4.90164297687319_wp, -5.75406433753408_wp, 18.68816509613433_wp, & - & -6.18605568954342_wp, -8.57769474069993_wp, 17.43910348679760_wp, & - & -3.24350105293640_wp, -7.46973329881938_wp, 16.37032740220168_wp, & - & -5.44484281127273_wp, -1.76139654980639_wp, 16.48390182148039_wp, & - & -7.45351378099656_wp, 1.49347687389288_wp, 13.13898673574900_wp, & - & -7.68282068658808_wp, 2.38897831701990_wp, 11.29898325562969_wp, & - & -5.72170844983021_wp, 2.23715773425336_wp, 13.97522259365416_wp, & - & -9.03185824727238_wp, 2.07577135873148_wp, 14.35092845826368_wp, & - & -12.58185017247340_wp, 0.70698805160297_wp, 10.11158718347043_wp, & - & -13.22024495156878_wp, -2.16522909544526_wp, 8.51641281789017_wp, & - & -13.53213099141864_wp, 0.28360062184078_wp, 4.74165688827974_wp, & - & -12.17023762510128_wp, 2.95020235752383_wp, 6.21916935735296_wp, & - & -5.47317169297864_wp, -6.30777860711551_wp, 5.37945073452325_wp, & - & -2.91575454319409_wp, 1.17077593243519_wp, 9.10079167045084_wp],& - & shape(xyz)) - call init(mol, sym, xyz) - end subroutine grubbs +subroutine grubbs(mol) + type(TMolecule), intent(inout) :: mol + integer, parameter :: nat = 75 + character(len=*), parameter :: sym(nat) = [character(len=4) ::& + & "Ru", "C", "C", "C", "C", "C", "C", "C", "O", "C", "C", "H", "H", & + & "H", "C", "H", "H", "H", "H", "H", "H", "H", "H", "H", "C", "N", & + & "C", "C", "C", "C", "C", "C", "C", "H", "H", "H", "H", "C", "H", & + & "H", "H", "H", "C", "H", "H", "H", "C", "C", "N", "C", "C", "C", & + & "C", "C", "C", "C", "H", "H", "H", "H", "C", "H", "H", "H", "H", & + & "C", "H", "H", "H", "H", "H", "H", "H", "Cl", "Cl"] + real(wp), parameter :: xyz(3, nat) = reshape([& + & -4.48876242338909_wp, -2.09410736961751_wp, 6.48025767395976_wp, & + & -3.39542935008205_wp, -1.00934609321648_wp, 3.37297562635250_wp, & + & -0.89096799057465_wp, -1.65719139178430_wp, 2.52794687360526_wp, & + & -0.00187838759360_wp, -1.02726825411961_wp, 0.11235554604142_wp, & + & 2.39977999054608_wp, -1.73257067017581_wp, -0.66001135422939_wp, & + & 3.94523944585223_wp, -3.08713189980991_wp, 0.98469839765979_wp, & + & 3.13084315074310_wp, -3.73573308875744_wp, 3.40383674083047_wp, & + & 0.72574925082760_wp, -3.01450028294867_wp, 4.16236328824863_wp, & + & -0.34548725695431_wp, -3.51939537235595_wp, 6.43739490997780_wp, & + & 1.10498701323636_wp, -4.64071528697208_wp, 8.49906135422373_wp, & + & -0.81899588806972_wp, -5.50999300310070_wp, 10.42067453918938_wp, & + & -2.16671442004141_wp, -6.83194323202777_wp, 9.58791577703093_wp, & + & 0.14674477886673_wp, -6.44058098792832_wp, 11.99173033247876_wp, & + & -1.86211705317798_wp, -3.89003299196946_wp, 11.18088861188026_wp, & + & 2.94345036670699_wp, -2.71461211315089_wp, 9.54109403718520_wp, & + & 4.25175488455419_wp, -2.02822207439526_wp, 8.10113798162831_wp, & + & 1.90191279194423_wp, -1.09894933882835_wp, 10.29213915957009_wp, & + & 4.05380231191340_wp, -3.56092776926960_wp, 11.06322671537322_wp, & + & 2.09442106412509_wp, -6.28009790141020_wp, 7.69876997360015_wp, & + & 4.36447703742976_wp, -4.78998851915897_wp, 4.65115224339005_wp, & + & 5.82373853328467_wp, -3.65349977434782_wp, 0.38695351345974_wp, & + & 3.07317627367435_wp, -1.24186175346991_wp, -2.53223088233232_wp, & + & -1.25251791809799_wp, 0.01729855133987_wp, -1.13979009604457_wp, & + & -4.50256120227086_wp, 0.08700676215754_wp, 2.02024932061518_wp, & + & -7.98117439891502_wp, -0.91146395822073_wp, 6.61491387592883_wp, & + & -9.54120931046810_wp, 0.23196386027623_wp, 4.93017972843353_wp, & + & -8.81626697262086_wp, 1.20094351748977_wp, 2.52737617636858_wp, & + & -9.12263312297282_wp, -0.33655074294009_wp, 0.39778731232706_wp, & + & -8.32022713901198_wp, 0.60170386006383_wp, -1.92819510044706_wp, & + & -7.24034702473799_wp, 2.99722440832019_wp, -2.16074666549353_wp, & + & -6.95751930081047_wp, 4.46636539143802_wp, 0.00913871469080_wp, & + & -7.72222903153473_wp, 3.60494893525848_wp, 2.37913095509811_wp, & + & -7.20124859484703_wp, 5.10159865902023_wp, 4.72196405416212_wp, & + & -6.40848210295356_wp, 6.94912135869179_wp, 4.26394361692715_wp, & + & -8.90386710872648_wp, 5.41338265366883_wp, 5.85428028407721_wp, & + & -5.85075405545582_wp, 4.11205689375239_wp, 5.94471689883273_wp, & + & -6.07723204130125_wp, 6.31818721764424_wp, -0.13610562177218_wp, & + & -6.41560636978241_wp, 3.96790859834000_wp, -4.68988595617280_wp, & + & -5.00475020411875_wp, 5.46289536326637_wp, -4.51108764575409_wp, & + & -5.61432855221330_wp, 2.46525899468923_wp, -5.85859641814541_wp, & + & -8.01116812918227_wp, 4.75888551975949_wp, -5.74517506666859_wp, & + & -8.51402987346811_wp, -0.58379681696829_wp, -3.59647918355373_wp, & + & -10.11190843688181_wp, -2.97112351350850_wp, 0.67258748042197_wp, & + & -10.35742352194046_wp, -3.87297632555110_wp, -1.16520313061071_wp, & + & -11.93170696715124_wp, -3.01882775537256_wp, 1.65559268363119_wp, & + & -8.80853799348823_wp, -4.13077840873208_wp, 1.79194019032488_wp, & + & -12.00826165508321_wp, 0.89370998292708_wp, 6.00001216983511_wp, & + & -11.99803445824562_wp, -0.48821258872689_wp, 8.52708221059990_wp, & + & -9.34971393139607_wp, -1.22700094860463_wp, 8.78345188151131_wp, & + & -8.45101507196284_wp, -2.63174385082231_wp, 10.90901184982892_wp, & + & -7.37601611981588_wp, -1.32890819987238_wp, 12.95669810150194_wp, & + & -6.33567852103093_wp, -2.74890119050089_wp, 14.91661225200796_wp, & + & -6.40297544153730_wp, -5.38068850502004_wp, 14.91783301497120_wp, & + & -7.66406515654131_wp, -6.60173870661033_wp, 12.95345155232105_wp, & + & -8.73996550796608_wp, -5.27286452180504_wp, 10.95168753094190_wp, & + & -10.30065615442357_wp, -6.64280056176261_wp, 9.02763659950165_wp, & + & -10.40423770288240_wp, -5.65022200689425_wp, 7.22532748289297_wp, & + & -9.53138840470961_wp, -8.51497473644276_wp, 8.63796754985277_wp, & + & -12.23007579728577_wp, -6.89514322667607_wp, 9.74487452465361_wp, & + & -7.82480146633663_wp, -8.65107468903709_wp, 12.97505111992152_wp, & + & -5.13310794949881_wp, -6.86601499089360_wp, 16.96523202829993_wp, & + & -4.90164297687319_wp, -5.75406433753408_wp, 18.68816509613433_wp, & + & -6.18605568954342_wp, -8.57769474069993_wp, 17.43910348679760_wp, & + & -3.24350105293640_wp, -7.46973329881938_wp, 16.37032740220168_wp, & + & -5.44484281127273_wp, -1.76139654980639_wp, 16.48390182148039_wp, & + & -7.45351378099656_wp, 1.49347687389288_wp, 13.13898673574900_wp, & + & -7.68282068658808_wp, 2.38897831701990_wp, 11.29898325562969_wp, & + & -5.72170844983021_wp, 2.23715773425336_wp, 13.97522259365416_wp, & + & -9.03185824727238_wp, 2.07577135873148_wp, 14.35092845826368_wp, & + & -12.58185017247340_wp, 0.70698805160297_wp, 10.11158718347043_wp, & + & -13.22024495156878_wp, -2.16522909544526_wp, 8.51641281789017_wp, & + & -13.53213099141864_wp, 0.28360062184078_wp, 4.74165688827974_wp, & + & -12.17023762510128_wp, 2.95020235752383_wp, 6.21916935735296_wp, & + & -5.47317169297864_wp, -6.30777860711551_wp, 5.37945073452325_wp, & + & -2.91575454319409_wp, 1.17077593243519_wp, 9.10079167045084_wp],& + & shape(xyz)) + call init(mol, sym, xyz) +end subroutine grubbs - subroutine remdesivir(mol) - type(TMolecule), intent(inout) :: mol - integer, parameter :: nat = 77 - character(len=*), parameter :: sym(nat) = [character(len=4) ::& - & "P", "O", "N", "H", "C", "C", "O", "O", "C", "H", "C", "H", "C", & - & "C", "H", "H", "H", "H", "H", "C", "C", "H", "H", "H", "H", "H", & - & "H", "C", "H", "H", "H", "H", "O", "C", "C", "C", "C", "C", "C", & - & "H", "H", "H", "H", "H", "O", "C", "C", "C", "C", "O", "H", "H", & - & "C", "C", "N", "C", "C", "C", "C", "N", "N", "C", "N", "C", "N", & - & "H", "H", "H", "H", "H", "O", "H", "O", "H", "H", "H", "H"] - real(wp), parameter :: xyz(3, nat) = reshape([& - & -0.19132988942724_wp, -0.40972414993236_wp, -6.46745247268699_wp, & - & -0.88708370315348_wp, 1.57425420135113_wp, -8.31530734472471_wp, & - & -2.26653281976549_wp, -0.70381344345842_wp, -4.09986618135019_wp, & - & -2.11173222089634_wp, -2.37930900572134_wp, -3.20423243529946_wp, & - & -4.86798224614609_wp, 0.18225289406478_wp, -4.30097756552511_wp, & - & -6.27677559924320_wp, -1.11525632742753_wp, -6.46873009595223_wp, & - & -5.51905876432564_wp, -3.00081288327976_wp, -7.52001192348601_wp, & - & -8.47434896130393_wp, 0.03844979764335_wp, -6.95747164587644_wp, & - & -10.03544986524468_wp, -0.96247151044850_wp, -8.97893491976716_wp, & - & -11.92553948403753_wp, -1.01962112437940_wp, -8.18393281287400_wp, & - & -9.91996893316031_wp, 0.72014934689054_wp, -11.29995764502249_wp, & - & -10.49219335196244_wp, 2.62232232617395_wp, -10.71536445894101_wp, & - & -7.23550619143170_wp, 0.87644512354367_wp, -12.35847819278769_wp, & - & -6.87897439809205_wp, 2.83708304137020_wp, -14.42535601514885_wp, & - & -7.91274033059926_wp, 2.37928435595668_wp, -16.14387740068727_wp, & - & -7.50480813843883_wp, 4.69755740449728_wp, -13.79720095827741_wp, & - & -4.89131637876603_wp, 2.99533648526117_wp, -14.93249537526973_wp, & - & -6.68095383546727_wp, -0.98905693330672_wp, -13.05009790708299_wp, & - & -5.92831603844048_wp, 1.31709220244427_wp, -10.83195473545779_wp, & - & -11.81883395463374_wp, -0.21638516352561_wp, -13.27120005704696_wp, & - & -14.57820291988140_wp, -0.13823440252655_wp, -12.46760468875125_wp, & - & -15.09962799221286_wp, 1.73374750107546_wp, -11.78227793100761_wp, & - & -15.81183209717192_wp, -0.57984018774397_wp, -14.05459574765567_wp, & - & -15.01320381133929_wp, -1.48941780730427_wp, -10.97846457800362_wp, & - & -11.30523991685855_wp, -2.13790076670461_wp, -13.83308989189071_wp, & - & -11.60212248492759_wp, 0.93505736051472_wp, -14.96289818215977_wp, & - & -9.42330047711975_wp, -2.87490672821927_wp, -9.41531345938043_wp, & - & -5.04282112259610_wp, 3.05026865184906_wp, -4.32998130896150_wp, & - & -4.01002824733346_wp, 3.80062049846515_wp, -2.72085258323442_wp, & - & -7.00023053390600_wp, 3.65000997903864_wp, -4.20915769754319_wp, & - & -4.22198186637037_wp, 3.81134084487576_wp, -6.04677579218044_wp, & - & -5.81121939607902_wp, -0.47906832308640_wp, -2.58584825044032_wp, & - & 2.47068801183837_wp, -0.11375678761847_wp, -4.92928504669041_wp, & - & 2.92927268291256_wp, 1.82311303997703_wp, -3.23788147405311_wp, & - & 4.31694667681501_wp, 1.21347428732154_wp, -1.10001374569184_wp, & - & 4.92882581296040_wp, 3.08964908400000_wp, 0.62256151918150_wp, & - & 4.15333643337733_wp, 5.56437325171411_wp, 0.22064670072489_wp, & - & 2.77450133560862_wp, 6.15249424200922_wp, -1.93426422378554_wp, & - & 2.16318169837946_wp, 4.29340911625344_wp, -3.68128192214883_wp, & - & 1.12254214460929_wp, 4.73864437690493_wp, -5.37821980658322_wp, & - & 2.16215515804734_wp, 8.07483114693414_wp, -2.26709260331350_wp, & - & 4.61493583816390_wp, 7.02200897692256_wp, 1.57707963977785_wp, & - & 6.01367922680868_wp, 2.60712876084823_wp, 2.28626955764142_wp, & - & 4.91847251835001_wp, -0.71791976724209_wp, -0.82106224185859_wp, & - & 0.48862131509161_wp, -3.15027245516979_wp, -7.56487341150835_wp, & - & -0.28365251447257_wp, -3.92900495641729_wp, -10.06103509313444_wp, & - & 1.93931407221488_wp, -5.01987573681761_wp, -11.47572727213072_wp, & - & 3.46194780403375_wp, -7.00005509254758_wp, -10.06109570800838_wp, & - & 5.52898042059816_wp, -5.44581508792227_wp, -8.80420942773199_wp, & - & 7.62409660046871_wp, -6.96790008764107_wp, -8.27975764432074_wp, & - & 8.89063621220764_wp, -5.81873810579412_wp, -7.58099930932030_wp, & - & 4.77873116045408_wp, -4.55591296051726_wp, -7.10871869864302_wp, & - & 5.98488325193633_wp, -3.28214046211090_wp, -10.78131744099112_wp, & - & 8.04420042616590_wp, -3.95737391706384_wp, -12.52727083968610_wp, & - & 9.69988749587325_wp, -4.39558589702530_wp, -13.88601683593368_wp, & - & 6.54330482327131_wp, -0.78383440890520_wp, -9.57046610088104_wp, & - & 5.52059329950252_wp, 1.57608902101080_wp, -10.08638609628190_wp, & - & 6.54855685480143_wp, 3.33074126268125_wp, -8.40250813030378_wp, & - & 8.21214243564971_wp, 2.03687260366483_wp, -6.84298150007518_wp, & - & 8.18991948783700_wp, -0.49591478301912_wp, -7.62041011860608_wp, & - & 9.62805038196471_wp, -2.33392280927626_wp, -6.55343562197677_wp, & - & 10.98869135966597_wp, -1.54613291279684_wp, -4.63623967569048_wp, & - & 11.07034938130244_wp, 0.76539452738098_wp, -3.59472088345013_wp, & - & 9.65919212948107_wp, 2.54832948990048_wp, -4.66761767959168_wp, & - & 9.68564318115148_wp, 4.89076718249344_wp, -3.63920321849348_wp, & - & 10.43606082735075_wp, 4.96688374705139_wp, -1.89321506855591_wp, & - & 8.13682851479651_wp, 5.96513261015273_wp, -3.87978909063992_wp, & - & 12.16148349338088_wp, -2.98423232166298_wp, -3.77895066773497_wp, & - & 6.10221882852163_wp, 5.31162664510204_wp, -8.30050533110730_wp, & - & 4.11071649734023_wp, 1.92211959433765_wp, -11.50538869802556_wp, & - & 3.68433105167984_wp, -3.04094982338455_wp, -12.15047372108470_wp, & - & 2.31364009015306_wp, -7.97109672786193_wp, -8.64122424792099_wp, & - & 4.47494932080769_wp, -8.73120728144298_wp, -11.82363408175874_wp, & - & 6.13555180213229_wp, -9.19639447872914_wp, -11.21105462844537_wp, & - & 1.22248128516574_wp, -5.84013634310975_wp, -13.22675900331083_wp, & - & -1.76661235190559_wp, -5.33561121819292_wp, -9.84945177134171_wp, & - & -1.03909744200315_wp, -2.31955212534116_wp, -11.09039554947463_wp],& - & shape(xyz)) - call init(mol, sym, xyz) - end subroutine remdesivir +subroutine remdesivir(mol) + type(TMolecule), intent(inout) :: mol + integer, parameter :: nat = 77 + character(len=*), parameter :: sym(nat) = [character(len=4) ::& + & "P", "O", "N", "H", "C", "C", "O", "O", "C", "H", "C", "H", "C", & + & "C", "H", "H", "H", "H", "H", "C", "C", "H", "H", "H", "H", "H", & + & "H", "C", "H", "H", "H", "H", "O", "C", "C", "C", "C", "C", "C", & + & "H", "H", "H", "H", "H", "O", "C", "C", "C", "C", "O", "H", "H", & + & "C", "C", "N", "C", "C", "C", "C", "N", "N", "C", "N", "C", "N", & + & "H", "H", "H", "H", "H", "O", "H", "O", "H", "H", "H", "H"] + real(wp), parameter :: xyz(3, nat) = reshape([& + & -0.19132988942724_wp, -0.40972414993236_wp, -6.46745247268699_wp, & + & -0.88708370315348_wp, 1.57425420135113_wp, -8.31530734472471_wp, & + & -2.26653281976549_wp, -0.70381344345842_wp, -4.09986618135019_wp, & + & -2.11173222089634_wp, -2.37930900572134_wp, -3.20423243529946_wp, & + & -4.86798224614609_wp, 0.18225289406478_wp, -4.30097756552511_wp, & + & -6.27677559924320_wp, -1.11525632742753_wp, -6.46873009595223_wp, & + & -5.51905876432564_wp, -3.00081288327976_wp, -7.52001192348601_wp, & + & -8.47434896130393_wp, 0.03844979764335_wp, -6.95747164587644_wp, & + & -10.03544986524468_wp, -0.96247151044850_wp, -8.97893491976716_wp, & + & -11.92553948403753_wp, -1.01962112437940_wp, -8.18393281287400_wp, & + & -9.91996893316031_wp, 0.72014934689054_wp, -11.29995764502249_wp, & + & -10.49219335196244_wp, 2.62232232617395_wp, -10.71536445894101_wp, & + & -7.23550619143170_wp, 0.87644512354367_wp, -12.35847819278769_wp, & + & -6.87897439809205_wp, 2.83708304137020_wp, -14.42535601514885_wp, & + & -7.91274033059926_wp, 2.37928435595668_wp, -16.14387740068727_wp, & + & -7.50480813843883_wp, 4.69755740449728_wp, -13.79720095827741_wp, & + & -4.89131637876603_wp, 2.99533648526117_wp, -14.93249537526973_wp, & + & -6.68095383546727_wp, -0.98905693330672_wp, -13.05009790708299_wp, & + & -5.92831603844048_wp, 1.31709220244427_wp, -10.83195473545779_wp, & + & -11.81883395463374_wp, -0.21638516352561_wp, -13.27120005704696_wp, & + & -14.57820291988140_wp, -0.13823440252655_wp, -12.46760468875125_wp, & + & -15.09962799221286_wp, 1.73374750107546_wp, -11.78227793100761_wp, & + & -15.81183209717192_wp, -0.57984018774397_wp, -14.05459574765567_wp, & + & -15.01320381133929_wp, -1.48941780730427_wp, -10.97846457800362_wp, & + & -11.30523991685855_wp, -2.13790076670461_wp, -13.83308989189071_wp, & + & -11.60212248492759_wp, 0.93505736051472_wp, -14.96289818215977_wp, & + & -9.42330047711975_wp, -2.87490672821927_wp, -9.41531345938043_wp, & + & -5.04282112259610_wp, 3.05026865184906_wp, -4.32998130896150_wp, & + & -4.01002824733346_wp, 3.80062049846515_wp, -2.72085258323442_wp, & + & -7.00023053390600_wp, 3.65000997903864_wp, -4.20915769754319_wp, & + & -4.22198186637037_wp, 3.81134084487576_wp, -6.04677579218044_wp, & + & -5.81121939607902_wp, -0.47906832308640_wp, -2.58584825044032_wp, & + & 2.47068801183837_wp, -0.11375678761847_wp, -4.92928504669041_wp, & + & 2.92927268291256_wp, 1.82311303997703_wp, -3.23788147405311_wp, & + & 4.31694667681501_wp, 1.21347428732154_wp, -1.10001374569184_wp, & + & 4.92882581296040_wp, 3.08964908400000_wp, 0.62256151918150_wp, & + & 4.15333643337733_wp, 5.56437325171411_wp, 0.22064670072489_wp, & + & 2.77450133560862_wp, 6.15249424200922_wp, -1.93426422378554_wp, & + & 2.16318169837946_wp, 4.29340911625344_wp, -3.68128192214883_wp, & + & 1.12254214460929_wp, 4.73864437690493_wp, -5.37821980658322_wp, & + & 2.16215515804734_wp, 8.07483114693414_wp, -2.26709260331350_wp, & + & 4.61493583816390_wp, 7.02200897692256_wp, 1.57707963977785_wp, & + & 6.01367922680868_wp, 2.60712876084823_wp, 2.28626955764142_wp, & + & 4.91847251835001_wp, -0.71791976724209_wp, -0.82106224185859_wp, & + & 0.48862131509161_wp, -3.15027245516979_wp, -7.56487341150835_wp, & + & -0.28365251447257_wp, -3.92900495641729_wp, -10.06103509313444_wp, & + & 1.93931407221488_wp, -5.01987573681761_wp, -11.47572727213072_wp, & + & 3.46194780403375_wp, -7.00005509254758_wp, -10.06109570800838_wp, & + & 5.52898042059816_wp, -5.44581508792227_wp, -8.80420942773199_wp, & + & 7.62409660046871_wp, -6.96790008764107_wp, -8.27975764432074_wp, & + & 8.89063621220764_wp, -5.81873810579412_wp, -7.58099930932030_wp, & + & 4.77873116045408_wp, -4.55591296051726_wp, -7.10871869864302_wp, & + & 5.98488325193633_wp, -3.28214046211090_wp, -10.78131744099112_wp, & + & 8.04420042616590_wp, -3.95737391706384_wp, -12.52727083968610_wp, & + & 9.69988749587325_wp, -4.39558589702530_wp, -13.88601683593368_wp, & + & 6.54330482327131_wp, -0.78383440890520_wp, -9.57046610088104_wp, & + & 5.52059329950252_wp, 1.57608902101080_wp, -10.08638609628190_wp, & + & 6.54855685480143_wp, 3.33074126268125_wp, -8.40250813030378_wp, & + & 8.21214243564971_wp, 2.03687260366483_wp, -6.84298150007518_wp, & + & 8.18991948783700_wp, -0.49591478301912_wp, -7.62041011860608_wp, & + & 9.62805038196471_wp, -2.33392280927626_wp, -6.55343562197677_wp, & + & 10.98869135966597_wp, -1.54613291279684_wp, -4.63623967569048_wp, & + & 11.07034938130244_wp, 0.76539452738098_wp, -3.59472088345013_wp, & + & 9.65919212948107_wp, 2.54832948990048_wp, -4.66761767959168_wp, & + & 9.68564318115148_wp, 4.89076718249344_wp, -3.63920321849348_wp, & + & 10.43606082735075_wp, 4.96688374705139_wp, -1.89321506855591_wp, & + & 8.13682851479651_wp, 5.96513261015273_wp, -3.87978909063992_wp, & + & 12.16148349338088_wp, -2.98423232166298_wp, -3.77895066773497_wp, & + & 6.10221882852163_wp, 5.31162664510204_wp, -8.30050533110730_wp, & + & 4.11071649734023_wp, 1.92211959433765_wp, -11.50538869802556_wp, & + & 3.68433105167984_wp, -3.04094982338455_wp, -12.15047372108470_wp, & + & 2.31364009015306_wp, -7.97109672786193_wp, -8.64122424792099_wp, & + & 4.47494932080769_wp, -8.73120728144298_wp, -11.82363408175874_wp, & + & 6.13555180213229_wp, -9.19639447872914_wp, -11.21105462844537_wp, & + & 1.22248128516574_wp, -5.84013634310975_wp, -13.22675900331083_wp, & + & -1.76661235190559_wp, -5.33561121819292_wp, -9.84945177134171_wp, & + & -1.03909744200315_wp, -2.31955212534116_wp, -11.09039554947463_wp],& + & shape(xyz)) + call init(mol, sym, xyz) +end subroutine remdesivir - subroutine taxol(mol) - type(TMolecule), intent(out) :: mol - integer, parameter :: nat = 113 - character(len=*), parameter :: sym(nat) = [character(len=4) ::& - & "C", "C", "C", "H", "H", "H", "C", "C", "H", "H", "C", "O", "H", & - & "C", "C", "H", "H", "H", "C", "H", "H", "H", "C", "H", "O", "C", & - & "O", "C", "C", "C", "C", "C", "C", "H", "H", "H", "H", "H", "C", & - & "H", "C", "C", "H", "H", "O", "C", "C", "H", "H", "C", "O", "H", & - & "H", "C", "C", "O", "C", "H", "O", "C", "O", "C", "H", "H", "H", & - & "C", "H", "H", "H", "H", "O", "C", "O", "C", "H", "H", "H", "H", & - & "O", "C", "O", "C", "O", "H", "H", "C", "N", "C", "O", "C", "C", & - & "C", "C", "C", "C", "H", "H", "H", "H", "H", "H", "C", "C", "C", & - & "C", "C", "C", "H", "H", "H", "H", "H", "H"] - real(wp), parameter :: xyz(3, nat) = reshape([& - & -4.27437796868034_wp, -4.21928318528357_wp, -0.64611116061329_wp, & - & -1.80385866712198_wp, -4.49179267962028_wp, -1.09021540834022_wp, & - & -0.70059193593179_wp, -4.65691453257619_wp, -3.70642288207301_wp, & - & -0.77845617901805_wp, -2.78919392789312_wp, -4.59464301033223_wp, & - & -1.78874135988759_wp, -5.97283783030446_wp, -4.85744945419119_wp, & - & 1.26314279112424_wp, -5.27006881075666_wp, -3.60817443221132_wp, & - & -0.00030627793660_wp, -4.28735666380398_wp, 1.08338125050305_wp, & - & -0.65818114921658_wp, -1.84867266482099_wp, 2.51351427841739_wp, & - & 0.02097488681957_wp, -0.25608865473600_wp, 1.39332843896544_wp, & - & 0.31820249428279_wp, -1.83782947791020_wp, 4.32582829373035_wp, & - & -3.51287249936110_wp, -1.53117587190408_wp, 3.01374411136104_wp, & - & -3.96408957494663_wp, -1.58852572013899_wp, 5.66082560828332_wp, & - & -3.85410979407103_wp, 0.13416152157481_wp, 6.35802848958120_wp, & - & -5.06473348475706_wp, -3.83511943726724_wp, 2.07224569636481_wp, & - & -7.82988726154316_wp, -3.24862641567655_wp, 2.66407218738313_wp, & - & -8.57751512507724_wp, -1.70211795076769_wp, 1.56233547447708_wp, & - & -9.02215566516809_wp, -4.89086427651674_wp, 2.38187413897498_wp, & - & -7.91832036862123_wp, -2.71727645474732_wp, 4.65300149439551_wp, & - & -4.43487627431995_wp, -6.19957849484587_wp, 3.68814161451424_wp, & - & -3.16666173986881_wp, -5.71060923581374_wp, 5.23126003699847_wp, & - & -3.58892170712183_wp, -7.67691934888030_wp, 2.53916899116474_wp, & - & -6.16327406414357_wp, -6.95263091914175_wp, 4.50886282119166_wp, & - & -4.43403718551753_wp, 1.02686240248629_wp, 1.94705639090826_wp, & - & -6.18131158908824_wp, 1.52853577257256_wp, 2.92988410174731_wp, & - & -2.51433610565894_wp, 2.84264996593750_wp, 2.48916823205561_wp, & - & -2.29619571371463_wp, 3.71544897188849_wp, 4.75974666499101_wp, & - & -3.45843813988640_wp, 3.04080573266905_wp, 6.64195764417307_wp, & - & -0.35881526898593_wp, 5.73730681871137_wp, 4.90275103505786_wp, & - & 0.01573951184733_wp, 6.96668740241894_wp, 7.19753930207764_wp, & - & 1.79861795419125_wp, 8.86461822319633_wp, 7.40872044489438_wp, & - & 3.22863211733955_wp, 9.54690928081462_wp, 5.32072062248882_wp, & - & 2.87462876765914_wp, 8.32936108834446_wp, 3.02759428398099_wp, & - & 1.09032295554875_wp, 6.42966577861662_wp, 2.81949561911974_wp, & - & 0.78730914442476_wp, 5.45812264610239_wp, 1.03840561302205_wp, & - & 3.99945821048446_wp, 8.86620906391446_wp, 1.39999905542228_wp, & - & 4.62745536175853_wp, 11.03585116854222_wp, 5.48333598031472_wp, & - & 2.08201830967716_wp, 9.82038999682105_wp, 9.20020197650751_wp, & - & -1.12603658919603_wp, 6.40017217464386_wp, 8.80801167182970_wp, & - & -4.82300580852231_wp, 1.32127056984249_wp, -0.96367561160434_wp, & - & -3.52073853698517_wp, 0.02066439441838_wp, -1.87788685728542_wp, & - & -3.93099610201992_wp, 3.98397715268175_wp, -1.70297356757830_wp, & - & -4.83129941478753_wp, 6.17236489511779_wp, -0.04168869813259_wp, & - & -6.03297601335802_wp, 5.68932716662825_wp, 1.55628363178919_wp, & - & -3.30467629744770_wp, 7.42122862396423_wp, 0.56355038684552_wp, & - & -6.28073043143666_wp, 7.26433146083583_wp, -2.08479012831368_wp, & - & -5.21395584472362_wp, 5.46771978659285_wp, -3.85434809136400_wp, & - & -7.24257272340474_wp, 4.26754074250294_wp, -5.45907543555252_wp, & - & -6.85660584984287_wp, 4.52839739712925_wp, -7.46596056716137_wp, & - & -9.03669122217812_wp, 5.19318007824272_wp, -5.03172441000641_wp, & - & -7.53481090861879_wp, 1.45790703557441_wp, -4.93777427722140_wp, & - & -9.87400670403454_wp, 0.79685819491794_wp, -6.04025449816774_wp, & - & -10.58886727469495_wp, -0.63731159892987_wp, -5.12172206442900_wp, & - & -5.96867901099894_wp, 0.43673079829201_wp, -5.83904305373725_wp, & - & -7.46204365640483_wp, 0.76234851320712_wp, -2.07457055170817_wp, & - & -8.15233562187160_wp, -2.01909322123343_wp, -2.33493227332548_wp, & - & -10.33171427134996_wp, -2.59912399220692_wp, -2.68891419923086_wp, & - & -5.98931042872122_wp, -3.77993231188434_wp, -2.87481355631034_wp, & - & -4.83786147817200_wp, -2.68912398014316_wp, -4.21557536076896_wp, & - & -6.55145543086553_wp, -5.90936485696088_wp, -4.39209333361281_wp, & - & -8.06352762045317_wp, -7.73378679749750_wp, -3.86009139873076_wp, & - & -8.37272258086699_wp, -9.39367763262380_wp, -5.44161707867957_wp, & - & -9.41219366870205_wp, -7.91270734405018_wp, -1.34385079733592_wp, & - & -10.54683450944101_wp, -9.62132856794695_wp, -1.32259528637126_wp, & - & -10.63033710334819_wp, -6.28174032417005_wp, -1.09700506273163_wp, & - & -8.04441104797831_wp, -7.99321079444480_wp, 0.17916508190017_wp, & - & -9.59071075883635_wp, 2.20866231152695_wp, -0.76450678915921_wp, & - & -9.56645809232997_wp, 1.88636215498546_wp, 1.26622532847853_wp, & - & -9.42785063755489_wp, 4.23105970566003_wp, -1.10198452210804_wp, & - & -11.38618948943588_wp, 1.53255140515293_wp, -1.51739726470692_wp, & - & -3.79061551084485_wp, 6.39309162438104_wp, -5.02734059999421_wp, & - & -1.27422200217135_wp, 4.10772123295000_wp, -1.98438268961729_wp, & - & -0.28743387275139_wp, 2.73731502671137_wp, -3.74861247521675_wp, & - & -1.37660416603083_wp, 1.25775077713349_wp, -5.13804670860084_wp, & - & 2.52758817477529_wp, 3.20847969134492_wp, -3.93207943550893_wp, & - & 3.30901888955614_wp, 2.04416350667181_wp, -5.43305639019368_wp, & - & 3.43451544368503_wp, 2.71575231203533_wp, -2.15613114788026_wp, & - & 2.88933025932021_wp, 5.19123884494056_wp, -4.32293373263776_wp, & - & -0.23087077739026_wp, -5.87614232880479_wp, 2.37349485145195_wp, & - & 2.52061909703465_wp, -4.25684618955045_wp, 0.19387448907145_wp, & - & 4.13063025163789_wp, -5.09244926377785_wp, 1.82395682951956_wp, & - & 3.73233690195010_wp, -5.74198777973861_wp, 4.00397638723427_wp, & - & 6.81305583067861_wp, -5.23478305505100_wp, 0.84181757850332_wp, & - & 8.32651037080541_wp, -6.27761170028085_wp, 2.77826741369310_wp, & - & 7.18930164181526_wp, -6.53483479739171_wp, 4.20703795330612_wp, & - & 6.92150744269002_wp, -6.42423563881976_wp, -0.84600037439096_wp, & - & 7.79700369915555_wp, -2.57312992561942_wp, 0.17536976028259_wp, & - & 6.29203608472598_wp, -1.63892325608139_wp, -1.88656905005969_wp, & - & 7.14424961136221_wp, -1.02265632319745_wp, -4.21522221586895_wp, & - & 5.74884371666377_wp, -0.93993421959222_wp, -6.04415109821061_wp, & - & 9.85346369971059_wp, -0.34493446296585_wp, -4.44925183904305_wp, & - & 11.10369929531118_wp, 1.16050692440512_wp, -2.69466751087552_wp, & - & 13.60102427963728_wp, 1.84094403320177_wp, -3.07750106640408_wp, & - & 14.87071389256069_wp, 1.02742909067580_wp, -5.21818777486650_wp, & - & 13.62867824577475_wp, -0.43970162177492_wp, -6.99900029232176_wp, & - & 11.12857518862883_wp, -1.10058730663001_wp, -6.62215913615899_wp, & - & 10.12544944506200_wp, -2.22935263919387_wp, -8.01239176157645_wp, & - & 14.61399690104017_wp, -1.05501490837713_wp, -8.68805610640805_wp, & - & 16.82969309541321_wp, 1.55352561784152_wp, -5.51038202215573_wp, & - & 14.56336107391366_wp, 3.01617997030377_wp, -1.70078080272236_wp, & - & 10.10364793716325_wp, 1.82779557593624_wp, -1.03565574792613_wp, & - & 4.44789716772231_wp, -2.14638203181252_wp, -1.75377902279299_wp, & - & 7.65649430197261_wp, -0.93019506774360_wp, 2.48608724258786_wp, & - & 5.68606140567588_wp, 0.75277614320481_wp, 2.87641442326019_wp, & - & 5.54105367548906_wp, 2.13612665304333_wp, 5.09291609602019_wp, & - & 7.36899800970274_wp, 1.84496195213717_wp, 6.94420672264969_wp, & - & 9.34031335281618_wp, 0.16048616574779_wp, 6.57432265205073_wp, & - & 9.47492767933860_wp, -1.22058982660547_wp, 4.35683012302981_wp, & - & 10.99066489411268_wp, -2.56873559858273_wp, 4.05860593053675_wp, & - & 10.77232312283835_wp, -0.07823692377195_wp, 8.02123940448809_wp, & - & 7.25497128542544_wp, 2.92907458474438_wp, 8.67906628566800_wp, & - & 3.99004733324701_wp, 3.44000682122569_wp, 5.38097191476319_wp, & - & 4.25346598365691_wp, 0.98335917704217_wp, 1.42864426000057_wp, & - & 9.75526108547830_wp, -2.73430178671873_wp, -0.43650459888694_wp],& - & shape(xyz)) - call init(mol, sym, xyz) - end subroutine taxol +subroutine taxol(mol) + type(TMolecule), intent(out) :: mol + integer, parameter :: nat = 113 + character(len=*), parameter :: sym(nat) = [character(len=4) ::& + & "C", "C", "C", "H", "H", "H", "C", "C", "H", "H", "C", "O", "H", & + & "C", "C", "H", "H", "H", "C", "H", "H", "H", "C", "H", "O", "C", & + & "O", "C", "C", "C", "C", "C", "C", "H", "H", "H", "H", "H", "C", & + & "H", "C", "C", "H", "H", "O", "C", "C", "H", "H", "C", "O", "H", & + & "H", "C", "C", "O", "C", "H", "O", "C", "O", "C", "H", "H", "H", & + & "C", "H", "H", "H", "H", "O", "C", "O", "C", "H", "H", "H", "H", & + & "O", "C", "O", "C", "O", "H", "H", "C", "N", "C", "O", "C", "C", & + & "C", "C", "C", "C", "H", "H", "H", "H", "H", "H", "C", "C", "C", & + & "C", "C", "C", "H", "H", "H", "H", "H", "H"] + real(wp), parameter :: xyz(3, nat) = reshape([& + & -4.27437796868034_wp, -4.21928318528357_wp, -0.64611116061329_wp, & + & -1.80385866712198_wp, -4.49179267962028_wp, -1.09021540834022_wp, & + & -0.70059193593179_wp, -4.65691453257619_wp, -3.70642288207301_wp, & + & -0.77845617901805_wp, -2.78919392789312_wp, -4.59464301033223_wp, & + & -1.78874135988759_wp, -5.97283783030446_wp, -4.85744945419119_wp, & + & 1.26314279112424_wp, -5.27006881075666_wp, -3.60817443221132_wp, & + & -0.00030627793660_wp, -4.28735666380398_wp, 1.08338125050305_wp, & + & -0.65818114921658_wp, -1.84867266482099_wp, 2.51351427841739_wp, & + & 0.02097488681957_wp, -0.25608865473600_wp, 1.39332843896544_wp, & + & 0.31820249428279_wp, -1.83782947791020_wp, 4.32582829373035_wp, & + & -3.51287249936110_wp, -1.53117587190408_wp, 3.01374411136104_wp, & + & -3.96408957494663_wp, -1.58852572013899_wp, 5.66082560828332_wp, & + & -3.85410979407103_wp, 0.13416152157481_wp, 6.35802848958120_wp, & + & -5.06473348475706_wp, -3.83511943726724_wp, 2.07224569636481_wp, & + & -7.82988726154316_wp, -3.24862641567655_wp, 2.66407218738313_wp, & + & -8.57751512507724_wp, -1.70211795076769_wp, 1.56233547447708_wp, & + & -9.02215566516809_wp, -4.89086427651674_wp, 2.38187413897498_wp, & + & -7.91832036862123_wp, -2.71727645474732_wp, 4.65300149439551_wp, & + & -4.43487627431995_wp, -6.19957849484587_wp, 3.68814161451424_wp, & + & -3.16666173986881_wp, -5.71060923581374_wp, 5.23126003699847_wp, & + & -3.58892170712183_wp, -7.67691934888030_wp, 2.53916899116474_wp, & + & -6.16327406414357_wp, -6.95263091914175_wp, 4.50886282119166_wp, & + & -4.43403718551753_wp, 1.02686240248629_wp, 1.94705639090826_wp, & + & -6.18131158908824_wp, 1.52853577257256_wp, 2.92988410174731_wp, & + & -2.51433610565894_wp, 2.84264996593750_wp, 2.48916823205561_wp, & + & -2.29619571371463_wp, 3.71544897188849_wp, 4.75974666499101_wp, & + & -3.45843813988640_wp, 3.04080573266905_wp, 6.64195764417307_wp, & + & -0.35881526898593_wp, 5.73730681871137_wp, 4.90275103505786_wp, & + & 0.01573951184733_wp, 6.96668740241894_wp, 7.19753930207764_wp, & + & 1.79861795419125_wp, 8.86461822319633_wp, 7.40872044489438_wp, & + & 3.22863211733955_wp, 9.54690928081462_wp, 5.32072062248882_wp, & + & 2.87462876765914_wp, 8.32936108834446_wp, 3.02759428398099_wp, & + & 1.09032295554875_wp, 6.42966577861662_wp, 2.81949561911974_wp, & + & 0.78730914442476_wp, 5.45812264610239_wp, 1.03840561302205_wp, & + & 3.99945821048446_wp, 8.86620906391446_wp, 1.39999905542228_wp, & + & 4.62745536175853_wp, 11.03585116854222_wp, 5.48333598031472_wp, & + & 2.08201830967716_wp, 9.82038999682105_wp, 9.20020197650751_wp, & + & -1.12603658919603_wp, 6.40017217464386_wp, 8.80801167182970_wp, & + & -4.82300580852231_wp, 1.32127056984249_wp, -0.96367561160434_wp, & + & -3.52073853698517_wp, 0.02066439441838_wp, -1.87788685728542_wp, & + & -3.93099610201992_wp, 3.98397715268175_wp, -1.70297356757830_wp, & + & -4.83129941478753_wp, 6.17236489511779_wp, -0.04168869813259_wp, & + & -6.03297601335802_wp, 5.68932716662825_wp, 1.55628363178919_wp, & + & -3.30467629744770_wp, 7.42122862396423_wp, 0.56355038684552_wp, & + & -6.28073043143666_wp, 7.26433146083583_wp, -2.08479012831368_wp, & + & -5.21395584472362_wp, 5.46771978659285_wp, -3.85434809136400_wp, & + & -7.24257272340474_wp, 4.26754074250294_wp, -5.45907543555252_wp, & + & -6.85660584984287_wp, 4.52839739712925_wp, -7.46596056716137_wp, & + & -9.03669122217812_wp, 5.19318007824272_wp, -5.03172441000641_wp, & + & -7.53481090861879_wp, 1.45790703557441_wp, -4.93777427722140_wp, & + & -9.87400670403454_wp, 0.79685819491794_wp, -6.04025449816774_wp, & + & -10.58886727469495_wp, -0.63731159892987_wp, -5.12172206442900_wp, & + & -5.96867901099894_wp, 0.43673079829201_wp, -5.83904305373725_wp, & + & -7.46204365640483_wp, 0.76234851320712_wp, -2.07457055170817_wp, & + & -8.15233562187160_wp, -2.01909322123343_wp, -2.33493227332548_wp, & + & -10.33171427134996_wp, -2.59912399220692_wp, -2.68891419923086_wp, & + & -5.98931042872122_wp, -3.77993231188434_wp, -2.87481355631034_wp, & + & -4.83786147817200_wp, -2.68912398014316_wp, -4.21557536076896_wp, & + & -6.55145543086553_wp, -5.90936485696088_wp, -4.39209333361281_wp, & + & -8.06352762045317_wp, -7.73378679749750_wp, -3.86009139873076_wp, & + & -8.37272258086699_wp, -9.39367763262380_wp, -5.44161707867957_wp, & + & -9.41219366870205_wp, -7.91270734405018_wp, -1.34385079733592_wp, & + & -10.54683450944101_wp, -9.62132856794695_wp, -1.32259528637126_wp, & + & -10.63033710334819_wp, -6.28174032417005_wp, -1.09700506273163_wp, & + & -8.04441104797831_wp, -7.99321079444480_wp, 0.17916508190017_wp, & + & -9.59071075883635_wp, 2.20866231152695_wp, -0.76450678915921_wp, & + & -9.56645809232997_wp, 1.88636215498546_wp, 1.26622532847853_wp, & + & -9.42785063755489_wp, 4.23105970566003_wp, -1.10198452210804_wp, & + & -11.38618948943588_wp, 1.53255140515293_wp, -1.51739726470692_wp, & + & -3.79061551084485_wp, 6.39309162438104_wp, -5.02734059999421_wp, & + & -1.27422200217135_wp, 4.10772123295000_wp, -1.98438268961729_wp, & + & -0.28743387275139_wp, 2.73731502671137_wp, -3.74861247521675_wp, & + & -1.37660416603083_wp, 1.25775077713349_wp, -5.13804670860084_wp, & + & 2.52758817477529_wp, 3.20847969134492_wp, -3.93207943550893_wp, & + & 3.30901888955614_wp, 2.04416350667181_wp, -5.43305639019368_wp, & + & 3.43451544368503_wp, 2.71575231203533_wp, -2.15613114788026_wp, & + & 2.88933025932021_wp, 5.19123884494056_wp, -4.32293373263776_wp, & + & -0.23087077739026_wp, -5.87614232880479_wp, 2.37349485145195_wp, & + & 2.52061909703465_wp, -4.25684618955045_wp, 0.19387448907145_wp, & + & 4.13063025163789_wp, -5.09244926377785_wp, 1.82395682951956_wp, & + & 3.73233690195010_wp, -5.74198777973861_wp, 4.00397638723427_wp, & + & 6.81305583067861_wp, -5.23478305505100_wp, 0.84181757850332_wp, & + & 8.32651037080541_wp, -6.27761170028085_wp, 2.77826741369310_wp, & + & 7.18930164181526_wp, -6.53483479739171_wp, 4.20703795330612_wp, & + & 6.92150744269002_wp, -6.42423563881976_wp, -0.84600037439096_wp, & + & 7.79700369915555_wp, -2.57312992561942_wp, 0.17536976028259_wp, & + & 6.29203608472598_wp, -1.63892325608139_wp, -1.88656905005969_wp, & + & 7.14424961136221_wp, -1.02265632319745_wp, -4.21522221586895_wp, & + & 5.74884371666377_wp, -0.93993421959222_wp, -6.04415109821061_wp, & + & 9.85346369971059_wp, -0.34493446296585_wp, -4.44925183904305_wp, & + & 11.10369929531118_wp, 1.16050692440512_wp, -2.69466751087552_wp, & + & 13.60102427963728_wp, 1.84094403320177_wp, -3.07750106640408_wp, & + & 14.87071389256069_wp, 1.02742909067580_wp, -5.21818777486650_wp, & + & 13.62867824577475_wp, -0.43970162177492_wp, -6.99900029232176_wp, & + & 11.12857518862883_wp, -1.10058730663001_wp, -6.62215913615899_wp, & + & 10.12544944506200_wp, -2.22935263919387_wp, -8.01239176157645_wp, & + & 14.61399690104017_wp, -1.05501490837713_wp, -8.68805610640805_wp, & + & 16.82969309541321_wp, 1.55352561784152_wp, -5.51038202215573_wp, & + & 14.56336107391366_wp, 3.01617997030377_wp, -1.70078080272236_wp, & + & 10.10364793716325_wp, 1.82779557593624_wp, -1.03565574792613_wp, & + & 4.44789716772231_wp, -2.14638203181252_wp, -1.75377902279299_wp, & + & 7.65649430197261_wp, -0.93019506774360_wp, 2.48608724258786_wp, & + & 5.68606140567588_wp, 0.75277614320481_wp, 2.87641442326019_wp, & + & 5.54105367548906_wp, 2.13612665304333_wp, 5.09291609602019_wp, & + & 7.36899800970274_wp, 1.84496195213717_wp, 6.94420672264969_wp, & + & 9.34031335281618_wp, 0.16048616574779_wp, 6.57432265205073_wp, & + & 9.47492767933860_wp, -1.22058982660547_wp, 4.35683012302981_wp, & + & 10.99066489411268_wp, -2.56873559858273_wp, 4.05860593053675_wp, & + & 10.77232312283835_wp, -0.07823692377195_wp, 8.02123940448809_wp, & + & 7.25497128542544_wp, 2.92907458474438_wp, 8.67906628566800_wp, & + & 3.99004733324701_wp, 3.44000682122569_wp, 5.38097191476319_wp, & + & 4.25346598365691_wp, 0.98335917704217_wp, 1.42864426000057_wp, & + & 9.75526108547830_wp, -2.73430178671873_wp, -0.43650459888694_wp],& + & shape(xyz)) + call init(mol, sym, xyz) +end subroutine taxol - subroutine pdb_4qxx(mol) - use xtb_mctc_filetypes, only: fileType - use xtb_type_vendordata, only: pdb_data - type(TMolecule), intent(out) :: mol - integer, parameter :: nat = 76 - character(len=*), parameter :: sym(nat) = [character(len=4) ::& - & "N", "C", "C", "O", "H", "H", "H", "H", "H", "N", "C", "C", "O", & - & "C", "C", "O", "N", "H", "H", "H", "H", "H", "H", "N", "C", "C", & - & "O", "C", "C", "C", "C", "H", "H", "H", "H", "H", "H", "H", "H", & - & "H", "H", "H", "N", "C", "C", "O", "C", "C", "C", "H", "H", "H", & - & "H", "H", "H", "H", "H", "H", "N", "C", "C", "O", "C", "O", "O", & - & "H", "H", "H", "H", "H", "O", "H", "H", "O", "H", "H"] - real(wp), parameter :: xyz(3, nat) = reshape([& - & -1.55146500437301_wp, -3.91551216694383_wp, 31.38645829187747_wp, & - & -3.22198274355175_wp, -4.43140735110197_wp, 29.26618577676599_wp, & - & -1.82925471891971_wp, -5.68429565548603_wp, 27.10622901671928_wp, & - & 0.48754929491868_wp, -5.63516278080430_wp, 27.00796326735582_wp, & - & -4.02511627200307_wp, -2.65506495876259_wp, 28.60100224261338_wp, & - & -4.74510185868531_wp, -5.66728812194235_wp, 29.89357479193267_wp, & - & -2.57758619484140_wp, -3.29190260367575_wp, 32.86989316207578_wp, & - & -0.28345889239458_wp, -2.57947592079070_wp, 30.88568091531371_wp, & - & -0.63116846706527_wp, -5.51422032004928_wp, 31.87589731274545_wp, & - & -3.25221835874051_wp, -6.80868259531787_wp, 25.36957086931514_wp, & - & -2.15617730814812_wp, -8.16928527881187_wp, 23.22662164281209_wp, & - & -3.30324095937153_wp, -7.36993120225914_wp, 20.72651421189187_wp, & - & -5.58414018017328_wp, -6.95986067126165_wp, 20.54699024670863_wp, & - & -2.55679920939913_wp, -11.01143310655488_wp, 23.51952916495316_wp, & - & -1.28312391957281_wp, -12.07723854195851_wp, 25.85712016423382_wp, & - & 0.98076776768526_wp, -11.72008033754134_wp, 26.25963179143412_wp, & - & -2.73632317458237_wp, -13.39248780266937_wp, 27.41236462050542_wp, & - & -5.15139293778421_wp, -6.72175520165020_wp, 25.53397702690399_wp, & - & -0.13228081645081_wp, -7.79134008895242_wp, 23.17370931623177_wp, & - & -1.78579102208587_wp, -11.95818580715279_wp, 21.86034978147020_wp, & - & -4.57880597514716_wp, -11.39315774831292_wp, 23.62724354406310_wp, & - & -4.58636487894435_wp, -13.64004190202731_wp, 27.00985299330512_wp, & - & -1.99555060245786_wp, -14.14837818238826_wp, 28.99973441791509_wp, & - & -1.71398143601258_wp, -7.18662778517731_wp, 18.79143483981153_wp, & - & -2.62293961762454_wp, -6.75765999468685_wp, 16.22518700066590_wp, & - & -1.47965541829972_wp, -8.80612292372503_wp, 14.56789734313224_wp, & - & 0.82581023984288_wp, -9.04800784523507_wp, 14.44317543047863_wp, & - & -1.84626225246338_wp, -4.12905119921442_wp, 15.27087539627081_wp, & - & -2.87994234672896_wp, -3.15395260937705_wp, 12.72919399446605_wp, & - & -2.31491428788909_wp, -0.36093765631577_wp, 12.41549948688271_wp, & - & -1.81791636322392_wp, -4.55234981185699_wp, 10.47097148505588_wp, & - & 0.16251643163956_wp, -7.34725449086758_wp, 19.10323962144556_wp, & - & -4.67707172451061_wp, -6.91828670037711_wp, 16.19117193357855_wp, & - & -2.42640811889763_wp, -2.77600741951761_wp, 16.71084656963529_wp, & - & 0.20975958037199_wp, -4.08558750238058_wp, 15.16694046905946_wp, & - & -4.92462582386855_wp, -3.39772725683640_wp, 12.73108372041535_wp, & - & -3.06702521570938_wp, 0.67841161579770_wp, 14.02743572163324_wp, & - & -3.19552658026159_wp, 0.32692258922842_wp, 10.68451051732646_wp, & - & -0.27778971454669_wp, -0.08125821581978_wp, 12.30778510777277_wp, & - & -2.20719990877915_wp, -6.56679767380783_wp, 10.66372353188419_wp, & - & -2.70041838154572_wp, -3.84559230681984_wp, 8.74943114524611_wp, & - & 0.21731848416918_wp, -4.25188338591874_wp, 10.37270573569242_wp, & - & -3.08970192710095_wp, -10.24987354898810_wp, 13.28288369761014_wp, & - & -2.20153073093126_wp, -12.20762963246002_wp, 11.56323308374967_wp, & - & -3.38449917519132_wp, -11.77299266412166_wp, 8.98564688890827_wp, & - & -5.69563401118181_wp, -11.73330841918642_wp, 8.73053388575314_wp, & - & -2.96120056254874_wp, -14.87592267286769_wp, 12.45896318371655_wp, & - & -1.91240266068878_wp, -16.88281163102133_wp, 10.64482627239122_wp, & - & -2.04657320308889_wp, -15.34457470829340_wp, 15.15182266146508_wp, & - & -4.96619979475309_wp, -9.98153246418790_wp, 13.50398163367791_wp, & - & -0.15117807594378_wp, -12.09802552740078_wp, 11.40260637805940_wp, & - & -5.01722239538411_wp, -15.00253431147060_wp, 12.44384537612217_wp, & - & -2.46231291193427_wp, -18.75741977272417_wp, 11.30056117679736_wp, & - & -2.67207249230626_wp, -16.56533767153940_wp, 8.75699004904330_wp, & - & 0.14172944619729_wp, -16.75053081457053_wp, 10.58813449391230_wp, & - & -2.60215263218227_wp, -17.23619038353991_wp, 15.74708633549371_wp, & - & 0.00566917784789_wp, -15.17827882475524_wp, 15.21796306969049_wp, & - & -2.88939097647544_wp, -13.95184668366135_wp, 16.41415959559562_wp, & - & -1.82547526702111_wp, -11.43662144514676_wp, 7.06001614657440_wp, & - & -2.88372179862755_wp, -11.12670638946201_wp, 4.54857035995840_wp, & - & -2.28089922080174_wp, -13.38870835077078_wp, 2.88939097647544_wp, & - & -0.82581023984288_wp, -15.07245417159460_wp, 3.59425875556331_wp, & - & -1.94830745372543_wp, -8.68518046297001_wp, 3.33914575240818_wp, & - & 0.68219106769630_wp, -8.79100511613065_wp, 2.91017796191771_wp, & - & -3.28245397392927_wp, -13.56445286405542_wp, 0.81069243224851_wp, & - & 0.06236095632681_wp, -11.39693720021151_wp, 7.33213668327320_wp, & - & -4.93218472766574_wp, -11.00198447680840_wp, 4.73187377704023_wp, & - & -2.91584713976561_wp, -8.40739074842332_wp, 1.54201637462653_wp, & - & -2.36971634041871_wp, -7.10347984340824_wp, 4.58825460489364_wp, & - & 1.23399104489108_wp, -7.23954011175764_wp, 2.14861840435094_wp, & - & 1.76689376259290_wp, -9.77933178761310_wp, 31.18425761530267_wp, & - & 1.50044240374199_wp, -10.43506669201923_wp, 29.51940905397182_wp, & - & 3.15395260937705_wp, -8.61904005474461_wp, 31.15969117796181_wp, & - & 1.30580063096438_wp, -15.88881578169100_wp, 33.78641024748494_wp, & - & 2.63049852142173_wp, -15.35402333803989_wp, 34.89567937972240_wp, & - & 1.87649786765214_wp, -15.79055003232754_wp, 32.07242881147236_wp],& - & shape(xyz)) - type(pdb_data), parameter :: pdb(nat) = [& - & pdb_data(name=" N ", residue="GLY", residue_number=1), & - & pdb_data(name=" CA ", residue="GLY", residue_number=1), & - & pdb_data(name=" C ", residue="GLY", residue_number=1), & - & pdb_data(name=" O ", residue="GLY", residue_number=1), & - & pdb_data(name=" HA2", residue="GLY", residue_number=1), & - & pdb_data(name=" HA3", residue="GLY", residue_number=1), & - & pdb_data(name=" H1 ", residue="GLY", residue_number=1), & - & pdb_data(name=" H2 ", residue="GLY", residue_number=1), & - & pdb_data(name=" H3 ", residue="GLY", residue_number=1), & - & pdb_data(name=" N ", residue="ASN", residue_number=2), & - & pdb_data(name=" CA ", residue="ASN", residue_number=2), & - & pdb_data(name=" C ", residue="ASN", residue_number=2), & - & pdb_data(name=" O ", residue="ASN", residue_number=2), & - & pdb_data(name=" CB ", residue="ASN", residue_number=2), & - & pdb_data(name=" CG ", residue="ASN", residue_number=2), & - & pdb_data(name=" OD1", residue="ASN", residue_number=2), & - & pdb_data(name=" ND2", residue="ASN", residue_number=2), & - & pdb_data(name=" H ", residue="ASN", residue_number=2), & - & pdb_data(name=" HA ", residue="ASN", residue_number=2), & - & pdb_data(name=" HB2", residue="ASN", residue_number=2), & - & pdb_data(name=" HB3", residue="ASN", residue_number=2), & - & pdb_data(name="HD21", residue="ASN", residue_number=2), & - & pdb_data(name="HD22", residue="ASN", residue_number=2), & - & pdb_data(name=" N ", residue="LEU", residue_number=3), & - & pdb_data(name=" CA ", residue="LEU", residue_number=3), & - & pdb_data(name=" C ", residue="LEU", residue_number=3), & - & pdb_data(name=" O ", residue="LEU", residue_number=3), & - & pdb_data(name=" CB ", residue="LEU", residue_number=3), & - & pdb_data(name=" CG ", residue="LEU", residue_number=3), & - & pdb_data(name=" CD1", residue="LEU", residue_number=3), & - & pdb_data(name=" CD2", residue="LEU", residue_number=3), & - & pdb_data(name=" H ", residue="LEU", residue_number=3), & - & pdb_data(name=" HA ", residue="LEU", residue_number=3), & - & pdb_data(name=" HB2", residue="LEU", residue_number=3), & - & pdb_data(name=" HB3", residue="LEU", residue_number=3), & - & pdb_data(name=" HG ", residue="LEU", residue_number=3), & - & pdb_data(name="HD11", residue="LEU", residue_number=3), & - & pdb_data(name="HD12", residue="LEU", residue_number=3), & - & pdb_data(name="HD13", residue="LEU", residue_number=3), & - & pdb_data(name="HD21", residue="LEU", residue_number=3), & - & pdb_data(name="HD22", residue="LEU", residue_number=3), & - & pdb_data(name="HD23", residue="LEU", residue_number=3), & - & pdb_data(name=" N ", residue="VAL", residue_number=4), & - & pdb_data(name=" CA ", residue="VAL", residue_number=4), & - & pdb_data(name=" C ", residue="VAL", residue_number=4), & - & pdb_data(name=" O ", residue="VAL", residue_number=4), & - & pdb_data(name=" CB ", residue="VAL", residue_number=4), & - & pdb_data(name=" CG1", residue="VAL", residue_number=4), & - & pdb_data(name=" CG2", residue="VAL", residue_number=4), & - & pdb_data(name=" H ", residue="VAL", residue_number=4), & - & pdb_data(name=" HA ", residue="VAL", residue_number=4), & - & pdb_data(name=" HB ", residue="VAL", residue_number=4), & - & pdb_data(name="HG11", residue="VAL", residue_number=4), & - & pdb_data(name="HG12", residue="VAL", residue_number=4), & - & pdb_data(name="HG13", residue="VAL", residue_number=4), & - & pdb_data(name="HG21", residue="VAL", residue_number=4), & - & pdb_data(name="HG22", residue="VAL", residue_number=4), & - & pdb_data(name="HG23", residue="VAL", residue_number=4), & - & pdb_data(name=" N ", residue="SER", residue_number=5), & - & pdb_data(name=" CA ", residue="SER", residue_number=5), & - & pdb_data(name=" C ", residue="SER", residue_number=5), & - & pdb_data(name=" O ", residue="SER", residue_number=5), & - & pdb_data(name=" CB ", residue="SER", residue_number=5), & - & pdb_data(name=" OG ", residue="SER", residue_number=5), & - & pdb_data(name=" OXT", residue="SER", residue_number=5), & - & pdb_data(name=" H ", residue="SER", residue_number=5), & - & pdb_data(name=" HA ", residue="SER", residue_number=5), & - & pdb_data(name=" HB2", residue="SER", residue_number=5), & - & pdb_data(name=" HB3", residue="SER", residue_number=5), & - & pdb_data(name=" HG ", residue="SER", residue_number=5), & - & pdb_data(name=" O ", residue="HOH", residue_number=101, het=.true.), & - & pdb_data(name=" H1 ", residue="HOH", residue_number=101, het=.true.), & - & pdb_data(name=" H2 ", residue="HOH", residue_number=101, het=.true.), & - & pdb_data(name=" O ", residue="HOH", residue_number=102, het=.true.), & - & pdb_data(name=" H1 ", residue="HOH", residue_number=102, het=.true.), & - & pdb_data(name=" H2 ", residue="HOH", residue_number=102, het=.true.)] - call init(mol, sym, xyz) - mol%ftype = fileType%pdb - mol%pdb = pdb - end subroutine pdb_4qxx +subroutine pdb_4qxx(mol) + use xtb_mctc_filetypes, only: fileType + use xtb_type_vendordata, only: pdb_data + type(TMolecule), intent(out) :: mol + integer, parameter :: nat = 76 + character(len=*), parameter :: sym(nat) = [character(len=4) ::& + & "N", "C", "C", "O", "H", "H", "H", "H", "H", "N", "C", "C", "O", & + & "C", "C", "O", "N", "H", "H", "H", "H", "H", "H", "N", "C", "C", & + & "O", "C", "C", "C", "C", "H", "H", "H", "H", "H", "H", "H", "H", & + & "H", "H", "H", "N", "C", "C", "O", "C", "C", "C", "H", "H", "H", & + & "H", "H", "H", "H", "H", "H", "N", "C", "C", "O", "C", "O", "O", & + & "H", "H", "H", "H", "H", "O", "H", "H", "O", "H", "H"] + real(wp), parameter :: xyz(3, nat) = reshape([& + & -1.55146500437301_wp, -3.91551216694383_wp, 31.38645829187747_wp, & + & -3.22198274355175_wp, -4.43140735110197_wp, 29.26618577676599_wp, & + & -1.82925471891971_wp, -5.68429565548603_wp, 27.10622901671928_wp, & + & 0.48754929491868_wp, -5.63516278080430_wp, 27.00796326735582_wp, & + & -4.02511627200307_wp, -2.65506495876259_wp, 28.60100224261338_wp, & + & -4.74510185868531_wp, -5.66728812194235_wp, 29.89357479193267_wp, & + & -2.57758619484140_wp, -3.29190260367575_wp, 32.86989316207578_wp, & + & -0.28345889239458_wp, -2.57947592079070_wp, 30.88568091531371_wp, & + & -0.63116846706527_wp, -5.51422032004928_wp, 31.87589731274545_wp, & + & -3.25221835874051_wp, -6.80868259531787_wp, 25.36957086931514_wp, & + & -2.15617730814812_wp, -8.16928527881187_wp, 23.22662164281209_wp, & + & -3.30324095937153_wp, -7.36993120225914_wp, 20.72651421189187_wp, & + & -5.58414018017328_wp, -6.95986067126165_wp, 20.54699024670863_wp, & + & -2.55679920939913_wp, -11.01143310655488_wp, 23.51952916495316_wp, & + & -1.28312391957281_wp, -12.07723854195851_wp, 25.85712016423382_wp, & + & 0.98076776768526_wp, -11.72008033754134_wp, 26.25963179143412_wp, & + & -2.73632317458237_wp, -13.39248780266937_wp, 27.41236462050542_wp, & + & -5.15139293778421_wp, -6.72175520165020_wp, 25.53397702690399_wp, & + & -0.13228081645081_wp, -7.79134008895242_wp, 23.17370931623177_wp, & + & -1.78579102208587_wp, -11.95818580715279_wp, 21.86034978147020_wp, & + & -4.57880597514716_wp, -11.39315774831292_wp, 23.62724354406310_wp, & + & -4.58636487894435_wp, -13.64004190202731_wp, 27.00985299330512_wp, & + & -1.99555060245786_wp, -14.14837818238826_wp, 28.99973441791509_wp, & + & -1.71398143601258_wp, -7.18662778517731_wp, 18.79143483981153_wp, & + & -2.62293961762454_wp, -6.75765999468685_wp, 16.22518700066590_wp, & + & -1.47965541829972_wp, -8.80612292372503_wp, 14.56789734313224_wp, & + & 0.82581023984288_wp, -9.04800784523507_wp, 14.44317543047863_wp, & + & -1.84626225246338_wp, -4.12905119921442_wp, 15.27087539627081_wp, & + & -2.87994234672896_wp, -3.15395260937705_wp, 12.72919399446605_wp, & + & -2.31491428788909_wp, -0.36093765631577_wp, 12.41549948688271_wp, & + & -1.81791636322392_wp, -4.55234981185699_wp, 10.47097148505588_wp, & + & 0.16251643163956_wp, -7.34725449086758_wp, 19.10323962144556_wp, & + & -4.67707172451061_wp, -6.91828670037711_wp, 16.19117193357855_wp, & + & -2.42640811889763_wp, -2.77600741951761_wp, 16.71084656963529_wp, & + & 0.20975958037199_wp, -4.08558750238058_wp, 15.16694046905946_wp, & + & -4.92462582386855_wp, -3.39772725683640_wp, 12.73108372041535_wp, & + & -3.06702521570938_wp, 0.67841161579770_wp, 14.02743572163324_wp, & + & -3.19552658026159_wp, 0.32692258922842_wp, 10.68451051732646_wp, & + & -0.27778971454669_wp, -0.08125821581978_wp, 12.30778510777277_wp, & + & -2.20719990877915_wp, -6.56679767380783_wp, 10.66372353188419_wp, & + & -2.70041838154572_wp, -3.84559230681984_wp, 8.74943114524611_wp, & + & 0.21731848416918_wp, -4.25188338591874_wp, 10.37270573569242_wp, & + & -3.08970192710095_wp, -10.24987354898810_wp, 13.28288369761014_wp, & + & -2.20153073093126_wp, -12.20762963246002_wp, 11.56323308374967_wp, & + & -3.38449917519132_wp, -11.77299266412166_wp, 8.98564688890827_wp, & + & -5.69563401118181_wp, -11.73330841918642_wp, 8.73053388575314_wp, & + & -2.96120056254874_wp, -14.87592267286769_wp, 12.45896318371655_wp, & + & -1.91240266068878_wp, -16.88281163102133_wp, 10.64482627239122_wp, & + & -2.04657320308889_wp, -15.34457470829340_wp, 15.15182266146508_wp, & + & -4.96619979475309_wp, -9.98153246418790_wp, 13.50398163367791_wp, & + & -0.15117807594378_wp, -12.09802552740078_wp, 11.40260637805940_wp, & + & -5.01722239538411_wp, -15.00253431147060_wp, 12.44384537612217_wp, & + & -2.46231291193427_wp, -18.75741977272417_wp, 11.30056117679736_wp, & + & -2.67207249230626_wp, -16.56533767153940_wp, 8.75699004904330_wp, & + & 0.14172944619729_wp, -16.75053081457053_wp, 10.58813449391230_wp, & + & -2.60215263218227_wp, -17.23619038353991_wp, 15.74708633549371_wp, & + & 0.00566917784789_wp, -15.17827882475524_wp, 15.21796306969049_wp, & + & -2.88939097647544_wp, -13.95184668366135_wp, 16.41415959559562_wp, & + & -1.82547526702111_wp, -11.43662144514676_wp, 7.06001614657440_wp, & + & -2.88372179862755_wp, -11.12670638946201_wp, 4.54857035995840_wp, & + & -2.28089922080174_wp, -13.38870835077078_wp, 2.88939097647544_wp, & + & -0.82581023984288_wp, -15.07245417159460_wp, 3.59425875556331_wp, & + & -1.94830745372543_wp, -8.68518046297001_wp, 3.33914575240818_wp, & + & 0.68219106769630_wp, -8.79100511613065_wp, 2.91017796191771_wp, & + & -3.28245397392927_wp, -13.56445286405542_wp, 0.81069243224851_wp, & + & 0.06236095632681_wp, -11.39693720021151_wp, 7.33213668327320_wp, & + & -4.93218472766574_wp, -11.00198447680840_wp, 4.73187377704023_wp, & + & -2.91584713976561_wp, -8.40739074842332_wp, 1.54201637462653_wp, & + & -2.36971634041871_wp, -7.10347984340824_wp, 4.58825460489364_wp, & + & 1.23399104489108_wp, -7.23954011175764_wp, 2.14861840435094_wp, & + & 1.76689376259290_wp, -9.77933178761310_wp, 31.18425761530267_wp, & + & 1.50044240374199_wp, -10.43506669201923_wp, 29.51940905397182_wp, & + & 3.15395260937705_wp, -8.61904005474461_wp, 31.15969117796181_wp, & + & 1.30580063096438_wp, -15.88881578169100_wp, 33.78641024748494_wp, & + & 2.63049852142173_wp, -15.35402333803989_wp, 34.89567937972240_wp, & + & 1.87649786765214_wp, -15.79055003232754_wp, 32.07242881147236_wp],& + & shape(xyz)) + type(pdb_data), parameter :: pdb(nat) = [& + & pdb_data(name=" N ", residue="GLY", residue_number=1), & + & pdb_data(name=" CA ", residue="GLY", residue_number=1), & + & pdb_data(name=" C ", residue="GLY", residue_number=1), & + & pdb_data(name=" O ", residue="GLY", residue_number=1), & + & pdb_data(name=" HA2", residue="GLY", residue_number=1), & + & pdb_data(name=" HA3", residue="GLY", residue_number=1), & + & pdb_data(name=" H1 ", residue="GLY", residue_number=1), & + & pdb_data(name=" H2 ", residue="GLY", residue_number=1), & + & pdb_data(name=" H3 ", residue="GLY", residue_number=1), & + & pdb_data(name=" N ", residue="ASN", residue_number=2), & + & pdb_data(name=" CA ", residue="ASN", residue_number=2), & + & pdb_data(name=" C ", residue="ASN", residue_number=2), & + & pdb_data(name=" O ", residue="ASN", residue_number=2), & + & pdb_data(name=" CB ", residue="ASN", residue_number=2), & + & pdb_data(name=" CG ", residue="ASN", residue_number=2), & + & pdb_data(name=" OD1", residue="ASN", residue_number=2), & + & pdb_data(name=" ND2", residue="ASN", residue_number=2), & + & pdb_data(name=" H ", residue="ASN", residue_number=2), & + & pdb_data(name=" HA ", residue="ASN", residue_number=2), & + & pdb_data(name=" HB2", residue="ASN", residue_number=2), & + & pdb_data(name=" HB3", residue="ASN", residue_number=2), & + & pdb_data(name="HD21", residue="ASN", residue_number=2), & + & pdb_data(name="HD22", residue="ASN", residue_number=2), & + & pdb_data(name=" N ", residue="LEU", residue_number=3), & + & pdb_data(name=" CA ", residue="LEU", residue_number=3), & + & pdb_data(name=" C ", residue="LEU", residue_number=3), & + & pdb_data(name=" O ", residue="LEU", residue_number=3), & + & pdb_data(name=" CB ", residue="LEU", residue_number=3), & + & pdb_data(name=" CG ", residue="LEU", residue_number=3), & + & pdb_data(name=" CD1", residue="LEU", residue_number=3), & + & pdb_data(name=" CD2", residue="LEU", residue_number=3), & + & pdb_data(name=" H ", residue="LEU", residue_number=3), & + & pdb_data(name=" HA ", residue="LEU", residue_number=3), & + & pdb_data(name=" HB2", residue="LEU", residue_number=3), & + & pdb_data(name=" HB3", residue="LEU", residue_number=3), & + & pdb_data(name=" HG ", residue="LEU", residue_number=3), & + & pdb_data(name="HD11", residue="LEU", residue_number=3), & + & pdb_data(name="HD12", residue="LEU", residue_number=3), & + & pdb_data(name="HD13", residue="LEU", residue_number=3), & + & pdb_data(name="HD21", residue="LEU", residue_number=3), & + & pdb_data(name="HD22", residue="LEU", residue_number=3), & + & pdb_data(name="HD23", residue="LEU", residue_number=3), & + & pdb_data(name=" N ", residue="VAL", residue_number=4), & + & pdb_data(name=" CA ", residue="VAL", residue_number=4), & + & pdb_data(name=" C ", residue="VAL", residue_number=4), & + & pdb_data(name=" O ", residue="VAL", residue_number=4), & + & pdb_data(name=" CB ", residue="VAL", residue_number=4), & + & pdb_data(name=" CG1", residue="VAL", residue_number=4), & + & pdb_data(name=" CG2", residue="VAL", residue_number=4), & + & pdb_data(name=" H ", residue="VAL", residue_number=4), & + & pdb_data(name=" HA ", residue="VAL", residue_number=4), & + & pdb_data(name=" HB ", residue="VAL", residue_number=4), & + & pdb_data(name="HG11", residue="VAL", residue_number=4), & + & pdb_data(name="HG12", residue="VAL", residue_number=4), & + & pdb_data(name="HG13", residue="VAL", residue_number=4), & + & pdb_data(name="HG21", residue="VAL", residue_number=4), & + & pdb_data(name="HG22", residue="VAL", residue_number=4), & + & pdb_data(name="HG23", residue="VAL", residue_number=4), & + & pdb_data(name=" N ", residue="SER", residue_number=5), & + & pdb_data(name=" CA ", residue="SER", residue_number=5), & + & pdb_data(name=" C ", residue="SER", residue_number=5), & + & pdb_data(name=" O ", residue="SER", residue_number=5), & + & pdb_data(name=" CB ", residue="SER", residue_number=5), & + & pdb_data(name=" OG ", residue="SER", residue_number=5), & + & pdb_data(name=" OXT", residue="SER", residue_number=5), & + & pdb_data(name=" H ", residue="SER", residue_number=5), & + & pdb_data(name=" HA ", residue="SER", residue_number=5), & + & pdb_data(name=" HB2", residue="SER", residue_number=5), & + & pdb_data(name=" HB3", residue="SER", residue_number=5), & + & pdb_data(name=" HG ", residue="SER", residue_number=5), & + & pdb_data(name=" O ", residue="HOH", residue_number=101, het=.true.), & + & pdb_data(name=" H1 ", residue="HOH", residue_number=101, het=.true.), & + & pdb_data(name=" H2 ", residue="HOH", residue_number=101, het=.true.), & + & pdb_data(name=" O ", residue="HOH", residue_number=102, het=.true.), & + & pdb_data(name=" H1 ", residue="HOH", residue_number=102, het=.true.), & + & pdb_data(name=" H2 ", residue="HOH", residue_number=102, het=.true.)] + call init(mol, sym, xyz) + mol%ftype = fileType%pdb + mol%pdb = pdb +end subroutine pdb_4qxx - subroutine manganese(mol) - type(TMolecule), intent(out) :: mol - integer, parameter :: nat = 37 - character(len=*), parameter :: sym(nat) = [character(len=4) ::& - & "Mn", "S ", "C ", "C ", "Cl", "C ", "Cl", "C ", "Cl", "C ", "Cl", & - & "C ", "S ", "S ", "C ", "C ", "Cl", "C ", "Cl", "C ", "Cl", "C ", & - & "Cl", "C ", "S ", "S ", "C ", "C ", "Cl", "C ", "Cl", "C ", "Cl", & - & "C ", "Cl", "C ", "S "] - real(wp), parameter :: xyz(3, nat) = reshape([& - & 16.92179988988945_wp, 18.98986097777520_wp, 3.24087546770245_wp, & - & 19.63586152587131_wp, 20.32013129211184_wp, 0.11672364757322_wp, & - & 22.42490162937085_wp, 18.63498480641440_wp, 0.51123530893977_wp, & - & 24.43533854799430_wp, 18.96679044749580_wp, -1.16619107933701_wp, & - & 24.10320655124145_wp, 21.04804012175429_wp, -3.62199123975962_wp, & - & 26.67304619249890_wp, 17.63473528700005_wp, -0.86283412858670_wp, & - & 29.10641492795817_wp, 18.06077343535132_wp, -2.93237789545227_wp, & - & 26.92967173230385_wp, 15.94170921101183_wp, 1.14409564764744_wp, & - & 29.67819006432741_wp, 14.30306793606362_wp, 1.52713667250176_wp, & - & 24.94495171617919_wp, 15.59872810861147_wp, 2.82212599233761_wp, & - & 25.24296074249298_wp, 13.52507399883359_wp, 5.28918929736323_wp, & - & 22.68267158721068_wp, 16.92807661463004_wp, 2.53303571661413_wp, & - & 20.20875462411216_wp, 16.47769596146290_wp, 4.63913679888663_wp, & - & 18.00855803970110_wp, 22.47123033971641_wp, 5.62523321580372_wp, & - & 16.61135949039080_wp, 22.08499945745968_wp, 8.57009936519192_wp, & - & 17.00003397727257_wp, 23.86543631901340_wp, 10.47904533917425_wp, & - & 18.88891635290602_wp, 26.42371499485825_wp, 9.87802385915071_wp, & - & 15.88411546633731_wp, 23.57816490451612_wp, 12.83421891560495_wp, & - & 16.38872067178397_wp, 25.76827696639874_wp, 15.14417153904157_wp, & - & 14.34348520569459_wp, 21.49009369752586_wp, 13.30913898303189_wp, & - & 12.96097870872229_wp, 21.12987678268715_wp, 16.19802483576108_wp, & - & 13.94509129133780_wp, 19.70979440802124_wp, 11.42632943070910_wp, & - & 12.06113958865126_wp, 17.13940636829330_wp, 11.99208881349134_wp, & - & 15.06583087111491_wp, 19.97579506723324_wp, 9.05128897640084_wp, & - & 14.57279532382023_wp, 17.72326932566981_wp, 6.71893913204056_wp, & - & 13.67978794100109_wp, 21.26749909850624_wp, 1.39841364309570_wp, & - & 11.89907990377364_wp, 19.12401451264176_wp, -0.33337902690679_wp, & - & 9.71226031141248_wp, 19.90517204008351_wp, -1.58848435777456_wp, & - & 8.80692038807563_wp, 23.00512724224015_wp, -1.38200628651352_wp, & - & 8.28045861229940_wp, 18.20608901448260_wp, -2.98007306663178_wp, & - & 5.61062695702381_wp, 19.19334345546141_wp, -4.49071280954136_wp, & - & 9.02964500024056_wp, 15.68171863620897_wp, -3.14110927593525_wp, & - & 7.27555526478972_wp, 13.58529918689250_wp, -4.84826842332567_wp, & - & 11.20095088742098_wp, 14.88598243998618_wp, -1.90593885307921_wp, & - & 12.13599654679039_wp, 11.79301714514339_wp, -2.09252037776529_wp, & - & 12.65253499366167_wp, 16.57942293287508_wp, -0.49502372796594_wp, & - & 15.35828807156226_wp, 15.55907882360629_wp, 1.05562907219407_wp],& - & shape(xyz)) - real(wp), parameter :: charge = -2.0_wp - call init(mol, sym, xyz, chrg=charge) - end subroutine manganese +subroutine manganese(mol) + type(TMolecule), intent(out) :: mol + integer, parameter :: nat = 37 + character(len=*), parameter :: sym(nat) = [character(len=4) ::& + & "Mn", "S ", "C ", "C ", "Cl", "C ", "Cl", "C ", "Cl", "C ", "Cl", & + & "C ", "S ", "S ", "C ", "C ", "Cl", "C ", "Cl", "C ", "Cl", "C ", & + & "Cl", "C ", "S ", "S ", "C ", "C ", "Cl", "C ", "Cl", "C ", "Cl", & + & "C ", "Cl", "C ", "S "] + real(wp), parameter :: xyz(3, nat) = reshape([& + & 16.92179988988945_wp, 18.98986097777520_wp, 3.24087546770245_wp, & + & 19.63586152587131_wp, 20.32013129211184_wp, 0.11672364757322_wp, & + & 22.42490162937085_wp, 18.63498480641440_wp, 0.51123530893977_wp, & + & 24.43533854799430_wp, 18.96679044749580_wp, -1.16619107933701_wp, & + & 24.10320655124145_wp, 21.04804012175429_wp, -3.62199123975962_wp, & + & 26.67304619249890_wp, 17.63473528700005_wp, -0.86283412858670_wp, & + & 29.10641492795817_wp, 18.06077343535132_wp, -2.93237789545227_wp, & + & 26.92967173230385_wp, 15.94170921101183_wp, 1.14409564764744_wp, & + & 29.67819006432741_wp, 14.30306793606362_wp, 1.52713667250176_wp, & + & 24.94495171617919_wp, 15.59872810861147_wp, 2.82212599233761_wp, & + & 25.24296074249298_wp, 13.52507399883359_wp, 5.28918929736323_wp, & + & 22.68267158721068_wp, 16.92807661463004_wp, 2.53303571661413_wp, & + & 20.20875462411216_wp, 16.47769596146290_wp, 4.63913679888663_wp, & + & 18.00855803970110_wp, 22.47123033971641_wp, 5.62523321580372_wp, & + & 16.61135949039080_wp, 22.08499945745968_wp, 8.57009936519192_wp, & + & 17.00003397727257_wp, 23.86543631901340_wp, 10.47904533917425_wp, & + & 18.88891635290602_wp, 26.42371499485825_wp, 9.87802385915071_wp, & + & 15.88411546633731_wp, 23.57816490451612_wp, 12.83421891560495_wp, & + & 16.38872067178397_wp, 25.76827696639874_wp, 15.14417153904157_wp, & + & 14.34348520569459_wp, 21.49009369752586_wp, 13.30913898303189_wp, & + & 12.96097870872229_wp, 21.12987678268715_wp, 16.19802483576108_wp, & + & 13.94509129133780_wp, 19.70979440802124_wp, 11.42632943070910_wp, & + & 12.06113958865126_wp, 17.13940636829330_wp, 11.99208881349134_wp, & + & 15.06583087111491_wp, 19.97579506723324_wp, 9.05128897640084_wp, & + & 14.57279532382023_wp, 17.72326932566981_wp, 6.71893913204056_wp, & + & 13.67978794100109_wp, 21.26749909850624_wp, 1.39841364309570_wp, & + & 11.89907990377364_wp, 19.12401451264176_wp, -0.33337902690679_wp, & + & 9.71226031141248_wp, 19.90517204008351_wp, -1.58848435777456_wp, & + & 8.80692038807563_wp, 23.00512724224015_wp, -1.38200628651352_wp, & + & 8.28045861229940_wp, 18.20608901448260_wp, -2.98007306663178_wp, & + & 5.61062695702381_wp, 19.19334345546141_wp, -4.49071280954136_wp, & + & 9.02964500024056_wp, 15.68171863620897_wp, -3.14110927593525_wp, & + & 7.27555526478972_wp, 13.58529918689250_wp, -4.84826842332567_wp, & + & 11.20095088742098_wp, 14.88598243998618_wp, -1.90593885307921_wp, & + & 12.13599654679039_wp, 11.79301714514339_wp, -2.09252037776529_wp, & + & 12.65253499366167_wp, 16.57942293287508_wp, -0.49502372796594_wp, & + & 15.35828807156226_wp, 15.55907882360629_wp, 1.05562907219407_wp],& + & shape(xyz)) + real(wp), parameter :: charge = -2.0_wp + call init(mol, sym, xyz, chrg=charge) +end subroutine manganese - subroutine vcpco4(mol) - type(TMolecule), intent(out) :: mol - integer, parameter :: nat = 19 - character(len=*), parameter :: sym(nat) = [character(len=4) ::& - & "V", "C", "C", "C", "C", "C", "H", "H", "H", "H", "H", "C", "C", "C", & - & "C", "O", "O", "O", "O"] - real(wp), parameter :: xyz(3, nat) = reshape([& - & 0.01825776267725_wp, 0.13110550404250_wp, -0.00041948324548_wp, & - & -1.89470237617899_wp, 4.08642287701680_wp, -0.00030420996203_wp, & - & -0.30782201031402_wp, 3.88425999400855_wp, 2.20719428591717_wp, & - & 2.27116070415413_wp, 3.55786274705629_wp, 1.36798210568814_wp, & - & 2.27143282469211_wp, 3.55811030115682_wp, -1.36783652495488_wp, & - & -0.30737225553597_wp, 3.88461526248869_wp, -2.20751735722155_wp, & - & -3.93427226450870_wp, 4.35896104443439_wp, -0.00049696200977_wp, & - & -0.94195923983321_wp, 3.98951206070242_wp, 4.16170760886828_wp, & - & 3.92482020592999_wp, 3.39076372920244_wp, 2.58034524280125_wp, & - & 3.92534932919828_wp, 3.39117568946133_wp, -2.57987462920319_wp, & - & -0.94109563507031_wp, 3.99017157506183_wp, -4.16214784318207_wp, & - & -3.29850987066545_wp, -1.29654655258453_wp, 0.00027026672926_wp, & - & -0.17610811102747_wp, -1.64797888903101_wp, -3.13400275137814_wp, & - & -0.17602496308531_wp, -1.64828313491028_wp, 3.13280851640703_wp, & - & 2.94080399470195_wp, -1.97941414538782_wp, -0.00023240037562_wp, & - & -5.38907023452527_wp, -2.16777069054547_wp, 0.00282139677283_wp, & - & -0.29329379714738_wp, -2.74172581747386_wp, -5.11399524942367_wp, & - & -0.29324466427246_wp, -2.74226249964599_wp, 5.11269330007294_wp, & - & 4.79632024388083_wp, -3.27840609987675_wp, 0.00107528998745_wp],& - & shape(xyz)) - call init(mol, sym, xyz) - end subroutine vcpco4 +subroutine vcpco4(mol) + type(TMolecule), intent(out) :: mol + integer, parameter :: nat = 19 + character(len=*), parameter :: sym(nat) = [character(len=4) ::& + & "V", "C", "C", "C", "C", "C", "H", "H", "H", "H", "H", "C", "C", "C", & + & "C", "O", "O", "O", "O"] + real(wp), parameter :: xyz(3, nat) = reshape([& + & 0.01825776267725_wp, 0.13110550404250_wp, -0.00041948324548_wp, & + & -1.89470237617899_wp, 4.08642287701680_wp, -0.00030420996203_wp, & + & -0.30782201031402_wp, 3.88425999400855_wp, 2.20719428591717_wp, & + & 2.27116070415413_wp, 3.55786274705629_wp, 1.36798210568814_wp, & + & 2.27143282469211_wp, 3.55811030115682_wp, -1.36783652495488_wp, & + & -0.30737225553597_wp, 3.88461526248869_wp, -2.20751735722155_wp, & + & -3.93427226450870_wp, 4.35896104443439_wp, -0.00049696200977_wp, & + & -0.94195923983321_wp, 3.98951206070242_wp, 4.16170760886828_wp, & + & 3.92482020592999_wp, 3.39076372920244_wp, 2.58034524280125_wp, & + & 3.92534932919828_wp, 3.39117568946133_wp, -2.57987462920319_wp, & + & -0.94109563507031_wp, 3.99017157506183_wp, -4.16214784318207_wp, & + & -3.29850987066545_wp, -1.29654655258453_wp, 0.00027026672926_wp, & + & -0.17610811102747_wp, -1.64797888903101_wp, -3.13400275137814_wp, & + & -0.17602496308531_wp, -1.64828313491028_wp, 3.13280851640703_wp, & + & 2.94080399470195_wp, -1.97941414538782_wp, -0.00023240037562_wp, & + & -5.38907023452527_wp, -2.16777069054547_wp, 0.00282139677283_wp, & + & -0.29329379714738_wp, -2.74172581747386_wp, -5.11399524942367_wp, & + & -0.29324466427246_wp, -2.74226249964599_wp, 5.11269330007294_wp, & + & 4.79632024388083_wp, -3.27840609987675_wp, 0.00107528998745_wp],& + & shape(xyz)) + call init(mol, sym, xyz) +end subroutine vcpco4 - subroutine feco5(mol) - type(TMolecule), intent(out) :: mol - integer, parameter :: nat = 11 - character(len=*), parameter :: sym(nat) = [character(len=4) ::& - & "fe", "c", "c", "c", "c", "c", "o", "o", "o", "o", "o"] - real(wp), parameter :: xyz(3, nat) = reshape([& - & -0.00000000000000_wp, 0.00414196770719_wp, 0.00000003847382_wp, & - & 0.00000000000000_wp, 3.39649674965194_wp, -0.00000185125214_wp, & - & 2.92058469648008_wp, -1.71911047193131_wp, 0.00000192819978_wp, & - & -2.92058469648008_wp, -1.71911047193131_wp, 0.00000192819978_wp, & - & 0.00000000000000_wp, 0.02144618830643_wp, 3.39858524690276_wp, & - & -0.00000000000000_wp, 0.02144618830643_wp, -3.39858516995512_wp, & - & 0.00000000000000_wp, 5.64401208242199_wp, -0.00000185125214_wp, & - & 4.85252146340858_wp, -2.86696025455742_wp, 0.00000003847382_wp, & - & -4.85252146340858_wp, -2.86696025455742_wp, 0.00000003847382_wp, & - & 0.00000000000000_wp, 0.03728587128806_wp, 5.63976243880901_wp, & - & -0.00000000000000_wp, 0.03728776101402_wp, -5.63976236186137_wp],& - & shape(xyz)) - call init(mol, sym, xyz) - end subroutine feco5 +subroutine feco5(mol) + type(TMolecule), intent(out) :: mol + integer, parameter :: nat = 11 + character(len=*), parameter :: sym(nat) = [character(len=4) ::& + & "fe", "c", "c", "c", "c", "c", "o", "o", "o", "o", "o"] + real(wp), parameter :: xyz(3, nat) = reshape([& + & -0.00000000000000_wp, 0.00414196770719_wp, 0.00000003847382_wp, & + & 0.00000000000000_wp, 3.39649674965194_wp, -0.00000185125214_wp, & + & 2.92058469648008_wp, -1.71911047193131_wp, 0.00000192819978_wp, & + & -2.92058469648008_wp, -1.71911047193131_wp, 0.00000192819978_wp, & + & 0.00000000000000_wp, 0.02144618830643_wp, 3.39858524690276_wp, & + & -0.00000000000000_wp, 0.02144618830643_wp, -3.39858516995512_wp, & + & 0.00000000000000_wp, 5.64401208242199_wp, -0.00000185125214_wp, & + & 4.85252146340858_wp, -2.86696025455742_wp, 0.00000003847382_wp, & + & -4.85252146340858_wp, -2.86696025455742_wp, 0.00000003847382_wp, & + & 0.00000000000000_wp, 0.03728587128806_wp, 5.63976243880901_wp, & + & -0.00000000000000_wp, 0.03728776101402_wp, -5.63976236186137_wp],& + & shape(xyz)) + call init(mol, sym, xyz) +end subroutine feco5 - subroutine bug332(mol) - use xtb_mctc_filetypes, only: fileType - use xtb_type_vendordata, only: sdf_data - type(TMolecule), intent(out) :: mol - integer, parameter :: nat = 13 - character(len=*), parameter :: sym(nat) = [character(len=4) ::& - & "O", "C", "C", "C", "C", "C", "N", "H", "H", "H", "H", "H", "H"] - real(wp), parameter :: xyz(3, nat) = reshape([& - & 2.81493577407313_wp, -4.24016708503309_wp, -0.05196746360567_wp, & - & 1.60154274202939_wp, -2.27863154966258_wp, -0.01417294461973_wp, & - & 2.83099844464216_wp, 0.08806122923725_wp, 0.44597532403414_wp, & - & 1.46340377513576_wp, 2.31302456193979_wp, 0.48452573339981_wp, & - & -1.07355331179575_wp, 2.33456743776178_wp, 0.09675396860402_wp, & - & -2.54527188110842_wp, -0.01870828689804_wp, -0.38777176479579_wp, & - & -0.96848454901482_wp, -2.31018997301585_wp, -0.41441690068088_wp, & - & 4.85281623779525_wp, 0.06500657265582_wp, 0.75551243452903_wp, & - & 2.44870688509933_wp, 4.07557195484931_wp, 0.83261325326035_wp, & - & -2.07113964042975_wp, 4.12319304877160_wp, 0.14021766543785_wp, & - & -3.51470129309789_wp, 0.11451739252741_wp, -2.22137285339888_wp, & - & -4.00017188947235_wp, -0.25964834543344_wp, 1.07695481850448_wp, & - & -1.83832540347633_wp, -4.00659695769996_wp, -0.74266229807381_wp], & - & shape(xyz)) - integer, parameter :: bonds(3, 13) = reshape([ & - & 1, 2, 2, & - & 2, 3, 1, & - & 3, 4, 2, & - & 3, 8, 1, & - & 4, 5, 1, & - & 4, 9, 1, & - & 5, 6, 1, & - & 5, 10, 1, & - & 6, 7, 1, & - & 6, 11, 1, & - & 6, 12, 1, & - & 7, 2, 1, & - & 7, 13, 1], & - & shape(bonds)) - integer, parameter :: charge_at = 5 - real(wp), parameter :: charge = 1.0_wp - integer :: ibond +subroutine bug332(mol) + use xtb_mctc_filetypes, only: fileType + use xtb_type_vendordata, only: sdf_data + type(TMolecule), intent(out) :: mol + integer, parameter :: nat = 13 + character(len=*), parameter :: sym(nat) = [character(len=4) ::& + & "O", "C", "C", "C", "C", "C", "N", "H", "H", "H", "H", "H", "H"] + real(wp), parameter :: xyz(3, nat) = reshape([& + & 2.81493577407313_wp, -4.24016708503309_wp, -0.05196746360567_wp, & + & 1.60154274202939_wp, -2.27863154966258_wp, -0.01417294461973_wp, & + & 2.83099844464216_wp, 0.08806122923725_wp, 0.44597532403414_wp, & + & 1.46340377513576_wp, 2.31302456193979_wp, 0.48452573339981_wp, & + & -1.07355331179575_wp, 2.33456743776178_wp, 0.09675396860402_wp, & + & -2.54527188110842_wp, -0.01870828689804_wp, -0.38777176479579_wp, & + & -0.96848454901482_wp, -2.31018997301585_wp, -0.41441690068088_wp, & + & 4.85281623779525_wp, 0.06500657265582_wp, 0.75551243452903_wp, & + & 2.44870688509933_wp, 4.07557195484931_wp, 0.83261325326035_wp, & + & -2.07113964042975_wp, 4.12319304877160_wp, 0.14021766543785_wp, & + & -3.51470129309789_wp, 0.11451739252741_wp, -2.22137285339888_wp, & + & -4.00017188947235_wp, -0.25964834543344_wp, 1.07695481850448_wp, & + & -1.83832540347633_wp, -4.00659695769996_wp, -0.74266229807381_wp], & + & shape(xyz)) + integer, parameter :: bonds(3, 13) = reshape([ & + & 1, 2, 2, & + & 2, 3, 1, & + & 3, 4, 2, & + & 3, 8, 1, & + & 4, 5, 1, & + & 4, 9, 1, & + & 5, 6, 1, & + & 5, 10, 1, & + & 6, 7, 1, & + & 6, 11, 1, & + & 6, 12, 1, & + & 7, 2, 1, & + & 7, 13, 1], & + & shape(bonds)) + integer, parameter :: charge_at = 5 + real(wp), parameter :: charge = 1.0_wp + integer :: ibond - call init(mol, sym, xyz, chrg=charge) - mol%ftype = fileType%sdf + call init(mol, sym, xyz, chrg=charge) + mol%ftype = fileType%sdf - allocate (mol%sdf(nat), source=sdf_data()) - mol%sdf(charge_at)%charge = nint(charge) + allocate (mol%sdf(nat), source=sdf_data()) + mol%sdf(charge_at)%charge = nint(charge) - call mol%bonds%allocate(size=size(bonds, 2), order=size(bonds, 1)) - do ibond = 1, size(bonds, 2) - call mol%bonds%push_back(bonds(:, ibond)) - end do + call mol%bonds%allocate(size=size(bonds, 2), order=size(bonds, 1)) + do ibond = 1, size(bonds, 2) + call mol%bonds%push_back(bonds(:, ibond)) + end do - end subroutine bug332 +end subroutine bug332 - subroutine co_cnx6(mol) - type(TMolecule), intent(out) :: mol - integer, parameter :: nat = 13 - character(len=*), parameter :: sym(nat) = [character(len=4) ::& - & "co", "c", "c", "c", "c", "c", "c", "n", "n", "n", "n", "n", "n"] - real(wp), parameter :: xyz(3, nat) = reshape([& - & 1.94877666423787_wp, 0.19317347093307_wp, -0.18341814349628_wp, & - & 1.81797069098334_wp, 2.09322297545391_wp, -0.13557960699323_wp, & - & 3.84410529185707_wp, 0.32638512462790_wp, -0.32326617548606_wp, & - & 0.05351867320654_wp, 0.05921970587159_wp, -0.04456772850566_wp, & - & 2.07888638555554_wp, -1.70686814314262_wp, -0.23025590574619_wp, & - & 2.09136372684550_wp, 0.15595598873397_wp, 1.71598181170762_wp, & - & 1.80637191292446_wp, 0.23061626304675_wp, -2.08282495154360_wp, & - & 5.00922648908409_wp, 0.40491540990094_wp, -0.40959258032660_wp, & - & -1.11165037804906_wp, -0.02302956650778_wp, 0.03747983755938_wp, & - & 1.73422256026807_wp, 3.26080060741577_wp, -0.10606602566732_wp, & - & 2.15910094532487_wp, -2.87478868845240_wp, -0.25552216296531_wp, & - & 2.18240567286263_wp, 0.13350207175117_wp, 2.88316823771709_wp, & - & 1.71548136489902_wp, 0.25339478036763_wp, -3.25001660625405_wp],& - & shape(xyz)) - real(wp), parameter :: charge = -3.0_wp - call init(mol, sym, xyz, chrg=charge) - end subroutine co_cnx6 +subroutine co_cnx6(mol) + type(TMolecule), intent(out) :: mol + integer, parameter :: nat = 13 + character(len=*), parameter :: sym(nat) = [character(len=4) ::& + & "co", "c", "c", "c", "c", "c", "c", "n", "n", "n", "n", "n", "n"] + real(wp), parameter :: xyz(3, nat) = reshape([& + & 1.94877666423787_wp, 0.19317347093307_wp, -0.18341814349628_wp, & + & 1.81797069098334_wp, 2.09322297545391_wp, -0.13557960699323_wp, & + & 3.84410529185707_wp, 0.32638512462790_wp, -0.32326617548606_wp, & + & 0.05351867320654_wp, 0.05921970587159_wp, -0.04456772850566_wp, & + & 2.07888638555554_wp, -1.70686814314262_wp, -0.23025590574619_wp, & + & 2.09136372684550_wp, 0.15595598873397_wp, 1.71598181170762_wp, & + & 1.80637191292446_wp, 0.23061626304675_wp, -2.08282495154360_wp, & + & 5.00922648908409_wp, 0.40491540990094_wp, -0.40959258032660_wp, & + & -1.11165037804906_wp, -0.02302956650778_wp, 0.03747983755938_wp, & + & 1.73422256026807_wp, 3.26080060741577_wp, -0.10606602566732_wp, & + & 2.15910094532487_wp, -2.87478868845240_wp, -0.25552216296531_wp, & + & 2.18240567286263_wp, 0.13350207175117_wp, 2.88316823771709_wp, & + & 1.71548136489902_wp, 0.25339478036763_wp, -3.25001660625405_wp],& + & shape(xyz)) + real(wp), parameter :: charge = -3.0_wp + call init(mol, sym, xyz, chrg=charge) +end subroutine co_cnx6 - subroutine fe_cnx6(mol) - type(TMolecule), intent(out) :: mol - integer, parameter :: nat = 13 - character(len=*), parameter :: sym(nat) = [character(len=4) ::& - & "fe", "c", "c", "c", "c", "c", "c", "n", "n", "n", "n", "n", "n"] - real(wp), parameter :: xyz(3, nat) = reshape([& - & 1.94840992315069_wp, 0.19244055581557_wp, -0.18393767617093_wp, & - & 1.78272604464510_wp, 2.62293683490692_wp, -0.10723975007002_wp, & - & 4.32689647736570_wp, 0.35980495482330_wp, -0.35944563157517_wp, & - & -0.43003654695118_wp, 0.02471213925081_wp, -0.00863311985379_wp, & - & 2.11416222449034_wp, -2.23778736891213_wp, -0.26000826782577_wp, & - & 2.12989310575441_wp, 0.16148305276099_wp, 2.24615988473859_wp, & - & 1.76690913095287_wp, 0.22401331347493_wp, -2.61356432743079_wp, & - & 5.49819068007791_wp, 0.44208319690825_wp, -0.44642524573858_wp, & - & -1.60132363118181_wp, -0.05824176614676_wp, 0.07779983551021_wp, & - & 1.70181293250445_wp, 3.79667254862885_wp, -0.08319943830802_wp, & - & 2.19561869833960_wp, -3.41158489904539_wp, -0.27871155631627_wp, & - & 2.21856307276739_wp, 0.13465068747712_wp, 3.41927390294530_wp, & - & 1.67795788808459_wp, 0.25531675005748_wp, -3.78654860990502_wp],& - & shape(xyz)) - real(wp), parameter :: charge = -4.0_wp - integer, parameter :: uhf = 4 - call init(mol, sym, xyz, chrg=charge, uhf=4) - end subroutine fe_cnx6 +subroutine fe_cnx6(mol) + type(TMolecule), intent(out) :: mol + integer, parameter :: nat = 13 + character(len=*), parameter :: sym(nat) = [character(len=4) ::& + & "fe", "c", "c", "c", "c", "c", "c", "n", "n", "n", "n", "n", "n"] + real(wp), parameter :: xyz(3, nat) = reshape([& + & 1.94840992315069_wp, 0.19244055581557_wp, -0.18393767617093_wp, & + & 1.78272604464510_wp, 2.62293683490692_wp, -0.10723975007002_wp, & + & 4.32689647736570_wp, 0.35980495482330_wp, -0.35944563157517_wp, & + & -0.43003654695118_wp, 0.02471213925081_wp, -0.00863311985379_wp, & + & 2.11416222449034_wp, -2.23778736891213_wp, -0.26000826782577_wp, & + & 2.12989310575441_wp, 0.16148305276099_wp, 2.24615988473859_wp, & + & 1.76690913095287_wp, 0.22401331347493_wp, -2.61356432743079_wp, & + & 5.49819068007791_wp, 0.44208319690825_wp, -0.44642524573858_wp, & + & -1.60132363118181_wp, -0.05824176614676_wp, 0.07779983551021_wp, & + & 1.70181293250445_wp, 3.79667254862885_wp, -0.08319943830802_wp, & + & 2.19561869833960_wp, -3.41158489904539_wp, -0.27871155631627_wp, & + & 2.21856307276739_wp, 0.13465068747712_wp, 3.41927390294530_wp, & + & 1.67795788808459_wp, 0.25531675005748_wp, -3.78654860990502_wp],& + & shape(xyz)) + real(wp), parameter :: charge = -4.0_wp + integer, parameter :: uhf = 4 + call init(mol, sym, xyz, chrg=charge, uhf=4) +end subroutine fe_cnx6 - subroutine h2o(mol) - type(TMolecule), intent(out) :: mol - integer, parameter :: nat = 3 - character(len=*), parameter :: sym(nat) = [character(len=4)::& - & "O", "H", "H"] - real(wp), parameter :: xyz(3, nat) = reshape([& - & 0.00000000000000_wp, 0.00000000000000_wp, 0.74114171466667_wp, & - & -1.42882182100000_wp, 0.00000000000000_wp, -0.37057085733333_wp, & - & 1.42882182100000_wp, 0.00000000000000_wp, -0.37057085733333_wp],& - & shape(xyz)) - real(wp), parameter :: charge = 0.0_wp - integer, parameter :: uhf = 0 - call init(mol, sym, xyz, chrg=charge, uhf=4) - end subroutine h2o +subroutine h2o(mol) + type(TMolecule), intent(out) :: mol + integer, parameter :: nat = 3 + character(len=*), parameter :: sym(nat) = [character(len=4)::& + & "O", "H", "H"] + real(wp), parameter :: xyz(3, nat) = reshape([& + & 0.00000000000000_wp, 0.00000000000000_wp, 0.74114171466667_wp, & + & -1.42882182100000_wp, 0.00000000000000_wp, -0.37057085733333_wp, & + & 1.42882182100000_wp, 0.00000000000000_wp, -0.37057085733333_wp],& + & shape(xyz)) + real(wp), parameter :: charge = 0.0_wp + integer, parameter :: uhf = 0 + call init(mol, sym, xyz, chrg=charge, uhf=4) +end subroutine h2o - subroutine MgH2(mol) - type(TMolecule), intent(out) :: mol - integer, parameter :: nat = 3 - character(len=*), parameter :: sym(nat) = [character(len=4)::& - & "Mg", "H", "H"] - real(wp), parameter :: xyz(3, nat) = reshape([& - & 0.00000000000000_wp, 0.00000000000000_wp, 0.00000000000000_wp, & - & -0.00000000000000_wp, -0.00000000000000_wp, -3.22563797588364_wp, & - & -0.00000000000000_wp, 0.00000000000000_wp, 3.22563797588364_wp],& - & shape(xyz)) - real(wp), parameter :: charge = 0.0_wp - integer, parameter :: uhf = 0 - call init(mol, sym, xyz, chrg=charge, uhf=4) - end subroutine MgH2 +subroutine MgH2(mol) + type(TMolecule), intent(out) :: mol + integer, parameter :: nat = 3 + character(len=*), parameter :: sym(nat) = [character(len=4)::& + & "Mg", "H", "H"] + real(wp), parameter :: xyz(3, nat) = reshape([& + & 0.00000000000000_wp, 0.00000000000000_wp, 0.00000000000000_wp, & + & -0.00000000000000_wp, -0.00000000000000_wp, -3.22563797588364_wp, & + & -0.00000000000000_wp, 0.00000000000000_wp, 3.22563797588364_wp],& + & shape(xyz)) + real(wp), parameter :: charge = 0.0_wp + integer, parameter :: uhf = 0 + call init(mol, sym, xyz, chrg=charge, uhf=4) +end subroutine MgH2 end module xtb_test_molstock