diff --git a/src/freq/io.f90 b/src/freq/io.f90
index 6d7b0ea21..975e39366 100644
--- a/src/freq/io.f90
+++ b/src/freq/io.f90
@@ -16,330 +16,326 @@
! along with xtb. If not, see .
module xtb_freq_io
- use xtb_mctc_accuracy, only : wp
- use xtb_lin, only : lin
+ use xtb_mctc_accuracy, only: wp
+ use xtb_lin, only: lin
implicit none
private
public :: writeHessianOut, rdhess, wrhess, write_tm_vibspectrum
public :: g98fake, g98fake2
-
contains
-
!> Write the second derivative matrix
-subroutine writeHessianOut(fname, hessian)
-
- !> File name
- character(len=*), intent(in) :: fname
-
- !> Dynamical (Hessian) matrix
- real(wp), intent(in) :: hessian(:,:)
-
- !> Format string for energy second derivative matrix
- character(len=*), parameter :: fmt = '(4f16.10)'
-
- 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
- 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.lt.nat3) goto 200
- enddo
- 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').ne.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.lt.nat3) goto 200
- enddo
- call close_file(iunit)
- goto 300
- endif
- goto 50
-
- 300 return
-end subroutine rdhess
-
-
-subroutine write_tm_vibspectrum(ich,n3,freq,ir_int)
- integer, intent(in) :: ich ! file handle
- integer, intent(in) :: n3
- real(wp),intent(in) :: freq(n3)
- real(wp),intent(in) :: ir_int(n3)
- integer :: i
- real(wp) :: thr=0.01_wp
- write(ich,'("$vibrational spectrum")')
- write(ich,'("# mode symmetry wave number IR intensity selection rules")')
- write(ich,'("# cm**(-1) (km*mol⁻¹) IR RAMAN")')
- do i = 1, n3
- if (abs(freq(i)).lt.thr) then
- write(ich,'(i6,9x, f18.2,f16.5,7x," - ",5x," - ")') &
- i,freq(i),0.0_wp
- else
- write(ich,'(i6,8x,"a",f18.2,f16.5,7x,"YES",5x,"YES")') &
- i,freq(i),ir_int(i)
- endif
- enddo
- 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)).gt.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)
- endif
- enddo
-
- 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
- enddo
- 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:'
-
- 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
- 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)
- enddo
- if (lb.eq.n) go to 90
- go to 70
- 90 if (kb.eq.k) then
- return
- endif
- ka=kc+1
- kc=kc+3
- go to 60
+ subroutine writeHessianOut(fname, hessian)
- 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))
+ !> File name
+ character(len=*), intent(in) :: fname
- write(gu,'(''end of file'')')
- call close_file(gu)
- return
+ !> Dynamical (Hessian) matrix
+ real(wp), intent(in) :: hessian(:, :)
-end subroutine g98fake2
+ !> Format string for energy second derivative matrix
+ character(len=*), parameter :: fmt = '(4f16.10)'
-!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+ 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 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)).gt.1.d-1)then
- k=k+1
- u(1:3*n,k)=u2(1:3*n,i)
- f2(k)=freq(i)
- endif
- enddo
-
- 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
- enddo
- 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:'
-
- 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
- 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)
- enddo
- if (lb.eq.n) go to 90
- go to 70
- 90 if (kb.eq.k) then
+ 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
+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
+
+300 return
+ end subroutine rdhess
+
+ subroutine write_tm_vibspectrum(ich, n3, freq, ir_int)
+ integer, intent(in) :: ich ! file handle
+ integer, intent(in) :: n3
+ real(wp), intent(in) :: freq(n3)
+ real(wp), intent(in) :: ir_int(n3)
+ integer :: i
+ real(wp) :: thr = 0.01_wp
+ write (ich, '("$vibrational spectrum")')
+ write (ich, '("# mode symmetry wave number IR intensity selection rules")')
+ write (ich, '("# cm**(-1) (km*mol⁻¹) IR RAMAN")')
+ do i = 1, n3
+ if (abs(freq(i)) < thr) then
+ write (ich, '(i6,9x, f18.2,f16.5,7x," - ",5x," - ")') &
+ i, freq(i), 0.0_wp
+ else
+ write (ich, '(i6,8x,"a",f18.2,f16.5,7x,"YES",5x,"YES")') &
+ i, freq(i), ir_int(i)
+ end if
+ end do
+ 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:'
+
+ 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
+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
+90 if (kb == k) then
+ 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
- endif
- 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))
+ end subroutine g98fake2
- write(gu,'(''end of file'')')
- call close_file(gu)
- return
+!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, *)
+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:'
+
+ 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
+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
+90 if (kb == k) then
+ 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
-end subroutine g98fake
+ end subroutine g98fake
end module xtb_freq_io
diff --git a/src/main/json.f90 b/src/main/json.f90
index c6e739faf..3b60a4971 100644
--- a/src/main/json.f90
+++ b/src/main/json.f90
@@ -55,445 +55,445 @@
! "version": 6.1
! }
module xtb_main_json
- implicit none
+ implicit none
contains
- subroutine main_json &
- (ijson, mol, wfx, xbas, sccres, freqres)
- use xtb_mctc_accuracy, only: wp
+ subroutine main_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
+ 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
- call write_json_header(ijson)
- call write_json_scc_results(ijson, sccres)
- if (freqres%gtot .gt. 0.0_wp) then
- call write_json_thermo(ijson, freqres)
- end if
- call write_json_charges(ijson, wfx)
- if (set%gfn_method .eq. 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 .gt. 0) then
- call write_json_frequencies(ijson, freqres)
- call write_json_reduced_masses(ijson, freqres)
- call write_json_intensities(ijson, freqres)
- end if
- call write_json_footer(ijson)
+ 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)
+ end if
+ call write_json_footer(ijson)
- end subroutine main_json
+ end subroutine main_json
- subroutine write_json_header(ijson)
- integer, intent(in) :: ijson
- write (ijson, '("{")')
- end subroutine write_json_header
+ 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_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_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', 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_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', 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_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_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_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_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_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_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_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_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)
- 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) 'IR intensities/amu'
- write (ijson, '(3x,f15.8,",")') (freqres%dipt(i), i=1, freqres%n3true - 1)
- write (ijson, '(3x,f15.8,"],")') freqres%dipt(freqres%n3true)
- end subroutine write_json_intensities
+ subroutine write_json_intensities(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) 'IR intensities/amu'
+ write (ijson, '(3x,f15.8,",")') (freqres%dipt(i), i=1, freqres%n3true - 1)
+ write (ijson, '(3x,f15.8,"],")') freqres%dipt(freqres%n3true)
+ 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_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, neigh, 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
- use xtb_gfnff_neighbor
- include 'xtb_version.fh'
- !> gfnff topology lists
- type(TGFFTopology), intent(in) :: topo
- !> gfnff neighbourlist
- type(TNeigh) :: neigh
- !> 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, i, j, n, l
+ subroutine write_json_gfnff_lists(n, etot, gnorm, topo, neigh, 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
+ use xtb_gfnff_neighbor
+ include 'xtb_version.fh'
+ !> gfnff topology lists
+ type(TGFFTopology), intent(in) :: topo
+ !> gfnff neighbourlist
+ type(TNeigh) :: neigh
+ !> 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, i, 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(numnb, n, numctr)
- write (iunit, '(3x,''"nb":'',"[")') ! open nb
- if (neigh%numctr.eq.1) then
- do j = 1, n - 1
- write (iunit, '(3x,"[",*(i7,:,","))', advance='no') neigh%nb(:, j, 1) ! open nb entry
- write (iunit, '("],")') ! close nb entry
- end do
- write (iunit, '(3x,"[",*(i7,:,","),"]",/)', advance='no') neigh%nb(:, n, 1)
- write (iunit, '("]")')
- else ! periodic boundary conditions
- do i=1, neigh%numctr-1 ! iterate over all cells
- write (iunit, '(3x,"[")') ! open cell
- do j = 1, n - 1
- write (iunit, '(3x,"[",*(i7,:,","))', advance='no') neigh%nb(:, j, i)
+ 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(numnb, n, numctr)
+ write (iunit, '(3x,''"nb":'',"[")') ! open nb
+ if (neigh%numctr == 1) then
+ do j = 1, n - 1
+ write (iunit, '(3x,"[",*(i7,:,","))', advance='no') neigh%nb(:, j, 1) ! open nb entry
+ write (iunit, '("],")') ! close nb entry
+ end do
+ write (iunit, '(3x,"[",*(i7,:,","),"]",/)', advance='no') neigh%nb(:, n, 1)
+ write (iunit, '("]")')
+ else ! periodic boundary conditions
+ do i = 1, neigh%numctr - 1 ! iterate over all cells
+ write (iunit, '(3x,"[")') ! open cell
+ do j = 1, n - 1
+ write (iunit, '(3x,"[",*(i7,:,","))', advance='no') neigh%nb(:, j, i)
+ write (iunit, '("],")')
+ end do
+ write (iunit, '(3x,"[",*(i7,:,","),"]",/)', advance='no') neigh%nb(:, n, i)
+ write (iunit, '("]")')
+ write (iunit, '(3x,"],")') ! close cell
+ end do
+ write (iunit, '(3x,"[")') ! open last cell
+ do j = 1, n - 1
+ write (iunit, '(3x,"[",*(i7,:,","))', advance='no') neigh%nb(:, j, neigh%numctr)
+ write (iunit, '("],")')
+ end do
+ write (iunit, '(3x,"[",*(i7,:,","),"]",/)', advance='no') neigh%nb(:, n, neigh%numctr)
+ write (iunit, '("]")')
+ write (iunit, '(3x,"]")') ! close last cell
+ end if
+ write (iunit, '(3x,"],")') ! close nb
+ end if
+ ! bpair(j,i,iTr) number bonds between i and j when j is translated by iTr
+ if (printTopo%bpair) then
+ write (iunit, '(3x,''"bpair":'',"[")') ! open bpair
+ if (neigh%numctr == 1) then
+ do i = 1, n - 1
+ write (iunit, '(3x,"[",*(i7,:,","))', advance='no') neigh%bpair(:, i, 1) ! open entry
+ write (iunit, '("],")') ! close entry
+ end do
+ write (iunit, '(3x,"[",*(i7,:,","),"]",/)', advance='no') neigh%bpair(:, n, 1)
+ write (iunit, '("]")')
+ else ! periodic boundary conditions
+ do i = 1, neigh%numctr - 1 ! iterate over all cells
+ write (iunit, '(3x,"[")') ! open cell
+ do j = 1, n - 1
+ write (iunit, '(3x,"[",*(i7,:,","))', advance='no') neigh%bpair(:, j, i)
+ write (iunit, '("],")')
+ end do
+ write (iunit, '(3x,"[",*(i7,:,","),"]",/)', advance='no') neigh%bpair(:, n, i)
+ write (iunit, '("]")')
+ write (iunit, '(3x,"],")') ! close cell
+ end do
+ write (iunit, '(3x,"[")') ! open last cell
+ do j = 1, n - 1
+ write (iunit, '(3x,"[",*(i7,:,","))', advance='no') neigh%bpair(:, j, neigh%numctr)
+ write (iunit, '("],")')
+ end do
+ write (iunit, '(3x,"[",*(i7,:,","),"]",/)', advance='no') neigh%bpair(:, n, neigh%numctr)
+ write (iunit, '("]")')
+ write (iunit, '(3x,"]")') ! close last cell
+ end if
+ write (iunit, '(3x,"],")') ! close bpair
+ 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,"[",*(i7,:,","),"]",/)', advance='no') neigh%nb(:, n, i)
- write (iunit, '("]")')
- write (iunit, '(3x,"],")') ! close cell
- enddo
- write (iunit, '(3x,"[")') ! open last cell
- do j = 1, n - 1
- write (iunit, '(3x,"[",*(i7,:,","))', advance='no') neigh%nb(:, j, neigh%numctr)
- write (iunit, '("],")')
- end do
- write (iunit, '(3x,"[",*(i7,:,","),"]",/)', advance='no') neigh%nb(:, n, neigh%numctr)
- write (iunit, '("]")')
- write (iunit, '(3x,"]")') ! close last cell
- endif
- write (iunit, '(3x,"],")') ! close nb
- end if
- ! bpair(j,i,iTr) number bonds between i and j when j is translated by iTr
- if (printTopo%bpair) then
- write (iunit, '(3x,''"bpair":'',"[")') ! open bpair
- if (neigh%numctr .eq. 1) then
- do i = 1, n - 1
- write (iunit, '(3x,"[",*(i7,:,","))', advance='no') neigh%bpair(:, i, 1) ! open entry
- write (iunit, '("],")') ! close entry
- end do
- write (iunit, '(3x,"[",*(i7,:,","),"]",/)', advance='no') neigh%bpair(:, n, 1)
- write (iunit, '("]")')
- else ! periodic boundary conditions
- do i=1, neigh%numctr-1 ! iterate over all cells
- write (iunit, '(3x,"[")') ! open cell
- do j = 1, n - 1
- write (iunit, '(3x,"[",*(i7,:,","))', advance='no') neigh%bpair(:, j, i)
+ 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, neigh%nbond - 1
+ write (iunit, '(3x,"[",*(i8,:,","))', advance='no') topo%blist(:, j)
write (iunit, '("],")')
- end do
- write (iunit, '(3x,"[",*(i7,:,","),"]",/)', advance='no') neigh%bpair(:, n, i)
- write (iunit, '("]")')
- write (iunit, '(3x,"],")') ! close cell
- enddo
- write (iunit, '(3x,"[")') ! open last cell
- do j = 1, n - 1
- write (iunit, '(3x,"[",*(i7,:,","))', advance='no') neigh%bpair(:, j, neigh%numctr)
- write (iunit, '("],")')
- end do
- write (iunit, '(3x,"[",*(i7,:,","),"]",/)', advance='no') neigh%bpair(:, n, neigh%numctr)
- write (iunit, '("]")')
- write (iunit, '(3x,"]")') ! close last cell
- endif
- write (iunit, '(3x,"],")') ! close bpair
- 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, neigh%nbond - 1
- write (iunit, '(3x,"[",*(i8,:,","))', advance='no') topo%blist(:, j)
- write (iunit, '("],")')
- end do
- write (iunit, '(3x,"[",*(i8,:,","),"]",/)', advance='no') topo%blist(:, neigh%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, neigh%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(:, neigh%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 .ge. 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 do
+ write (iunit, '(3x,"[",*(i8,:,","),"]",/)', advance='no') topo%blist(:, neigh%nbond)
+ write (iunit, '("]")')
+ write (iunit, '(3x,"],")')
end if
-
- write (iunit, '(3x,''"hbb":'',"[")') !> HBs bonded
- if (nlist%nhb2 .ge. 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,"],")')
+ 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
-
- write (iunit, '(3x,''"xb":'',"[")') !> XBs
- if (nlist%nxb .ge. 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,"],")')
+ 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, neigh%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(:, neigh%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,"[",*(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
- ! 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":'',"[")') !> 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,''"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":'',"[")') !> 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
- 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
+ ! 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)
+ ! 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
+ end subroutine write_json_gfnff_lists
end module xtb_main_json
diff --git a/src/main/property.F90 b/src/main/property.F90
index d7806d8fc..d33931e67 100644
--- a/src/main/property.F90
+++ b/src/main/property.F90
@@ -16,1363 +16,1360 @@
! along with xtb. If not, see .
module xtb_propertyoutput
- use xtb_mctc_accuracy, only : wp
- use xtb_mctc_io, only : stdout
- use xtb_mctc_symbols, only : toSymbol
+ use xtb_mctc_accuracy, only: wp
+ use xtb_mctc_io, only: stdout
+ use xtb_mctc_symbols, only: toSymbol
use xtb_solv_cm5
use xtb_cube
use xtb_topology
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/α"
- endif
- 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/α"
- endif
- 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 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
- use xtb_mctc_convert
+ 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)
+ 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/α"
+ end if
+ write (iunit, '(11x,49("-"))')
+ end subroutine write_energy_oniom
+
+ subroutine main_property &
+ (iunit, env, mol, wfx, basis, xtbData, res, solvModel, acc)
+
+ 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)
- endif
+ 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)
- endif
+ if (set%pr_mulliken .and. set%gfn_method == 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)
- endif
+ ! 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 == 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 == 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_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)
- endif
+ if (set%pr_spin_population .and. wfx%nopen /= 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
!! 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)
- endif
+ 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)
- endif
- 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)
- endif
-
- 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)
- endif
+ 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 == 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_tmmos) then
- call open_file(ifile,'mos','w')
- call write_tm_mos(ifile,mol%n,mol%at,basis,wfx)
- call close_file(ifile)
- endif
+ 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_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)
- endif
- endif
+ if (set%pr_dipole) then
+ if (set%gfn_method > 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
-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
+ 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)
- endif
+ ! 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)
- endif
- 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)
- endif
+ 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 <= basis%nao) &
+ call fermismear(.false., basis%nao, wfx%ihomoa, set%etemp, wfx%emo, focca, nfoda, efa, ga)
+ if (wfx%ihomob + 1 <= 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 == 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)
- endif
- 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)
- endif
+ if (set%pr_spin_density .and. wfx%nopen /= 0) then
+ allocate (C(basis%nbf, basis%nao), focc(basis%nao), emo(basis%nao), source=0.0_wp)
+ if (basis%nbf == 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)
- endif
- 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)
- endif
+ if (set%pr_density) then
+ allocate (C(basis%nbf, basis%nao), emo(basis%nao), source=0.0_wp)
+ if (basis%nbf == 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)
- endif
- call espplot(mol%n,basis%nao,basis%nbf,mol%at,mol%xyz,mol%z,wfx%focc,C,basis)
- deallocate(C)
- endif
+ if (set%pr_esp) then
+ allocate (C(basis%nbf, basis%nao), source=0.0_wp)
+ if (basis%nbf == 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)
- endif
- 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)
- endif
-
+ if (set%pr_stm) then
+ allocate (C(basis%nbf, basis%nao), focc(basis%nao), source=0.0_wp)
+ if (basis%nbf == basis%nao) then
+ C = wfx%C
+ else
+ call sao2cao(basis%nao, wfx%C, basis%nbf, C, basis)
+ end if
+ if (wfx%ihomoa + 1 <= wfx%nao) &
+ call fermismear(.false., basis%nao, wfx%ihomoa, set%etemp, wfx%emo, focc, nfoda, efa, ga)
+ if (wfx%ihomob + 1 <= 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⁻¹)'
- endif
- 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')
- call write_tm_vibspectrum(ifile,res%n3,res%freq,res%dipt)
- 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)
+ 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
- end if
+ call PREIGF(iunit, res%freq, res%n3true)
- 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)
- endif
- endif
-
- ! 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)
- endif
-
- call open_file(ifile,'.tmpxtbmodef','w')
- write(ifile,*) res%lowmode,res%lowmode
- write(ifile,*) res%etot ! energy for comparison
+ 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')
+ call write_tm_vibspectrum(ifile, res%n3, res%freq, res%dipt)
call close_file(ifile)
- endif
+ 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 /= -1) then
+ call writeNormalModesTurbomole(ifile, atmass, res%hess)
+ call close_file(ifile)
+ end if
+ end if
+
+ 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 /= -1) then
+ call enso_printout(ifile, res)
+ call close_file(ifile)
+ end if
+ end if
-end subroutine main_freq
+ ! distort along imags if present
+ call distort(mol, res%freq, res%hess)
+
+ if (set%pr_modef .and. (mol%n > 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 > 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
-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
+ call open_file(ifile, '.tmpxtbmodef', 'w')
+ write (ifile, *) res%lowmode, res%lowmode
+ write (ifile, *) res%etot ! energy for comparison
+ call close_file(ifile)
+
+ end if
+
+ end subroutine main_freq
+
+ 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 /= -1) then
+ do i = 1, n
+ write (ifile, '(f14.8)') q(i)
+ end do
+ end if
+ end subroutine print_charges
+
+ 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(ifile,'(f14.8)') q(i)
- enddo
- endif
-end subroutine print_charges
+ 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_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)
- enddo
-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)
+ 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 do
- end do
-end subroutine print_wbofile
+ 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
-
- 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 )
-
- 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
- enddo
- 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)
- enddo
- if (ibmax > 0) then
- write(iunit,'(i6,1x,i3,1x,a4,f6.3,1x,"--")',advance='no') &
- & i,at(i),sym(i),xsum
+ 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
+
+ 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) > 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 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
+ 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) < pp) cycle
+ k = j
+ pp = qmo(imo, j)
+ end do
+ if (k == 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 SUBROUTINE wibsort
+
+ end subroutine print_wiberg
+
+ 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)
+
+ write (iunit, '(a)')
+ if (nfrag > 1) then
+ write (iunit, '(1x,"*",1x,i0,1x,a)', advance='no') &
+ nfrag, "fragments found"
else
- write(iunit,'(i6,1x,i3,1x,a4,f6.3)') &
- & i,at(i),sym(i),xsum
+ write (iunit, '(1x,"*",1x,a)', advance='no') &
+ "no fragments found"
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)
- enddo
- write(iunit,'(a)')
+ write (iunit, '(1x,"(WBO >",f5.2,")")') thr
+ write (iunit, '(a)')
+ do i = 1, nfrag
+ call atl%new
+ call atl%add(fragment == i)
+ call atl%to_string(string)
+ write (iunit, '(3x,a,"(",i0,"):",1x,a)') "fragment", i, string
end do
- enddo
- write(iunit,'(1x,75("-"))')
- write(iunit,'(a)')
- deallocate(wbr,imem)
+ 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 == 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
+
+ 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
-contains
+ 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)')
+ 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 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)
- enddo
- 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
- enddo
-
-end SUBROUTINE wibsort
-
-end subroutine print_wiberg
-
-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
- endwhere
- forall(i = 1:n) cn(i) = sum(ceiling(bond(:,i)))
-
- call mrec(nfrag,cn,bond,n,at,fragment)
-
- 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"
- endif
- 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
- enddo
+ end subroutine print_molpol
-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
+ subroutine print_dipole(iunit, n, at, xyz, z, nao, P, dpint)
+ use xtb_mctc_convert
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, 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
+
+ ! 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
+
+ dip = norm2(d)
+
+ 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_dipole
+
+ 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
- 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
- endif
- enddo
- molcount=molcount-1
- end subroutine mrec
-
- recursive subroutine neighbours(i,cn,at,taken,n,bond, &
- & molvec,molcnt)
+ 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
+
+ end subroutine print_spin_population
+
+ 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) :: 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)
- endif
- enddo
- end subroutine neighbours
-
-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)')
- enddo
- 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_molpol
-
-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)
- enddo
-
- ! 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)
- enddo
- k = k+1
- d = d - P(i,i)*dpint(:,i,i)
- enddo
-
- dip = norm2(d)
-
- 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_dipole
-
-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)
- enddo
-
-end subroutine print_spin_population
-
-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)
- enddo
- if (ifile.ne.-1) then
+ 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 <= nao) &
+ call fermismear(.false., nao, ihomoa, etemp, emo, focca, nfoda, efa, ga)
+ if (ihomob + 1 <= 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(ifile,'(F14.8)') q(i)
- enddo
- endif
+ 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 /= -1) then
+ do i = 1, n
+ write (ifile, '(F14.8)') q(i)
+ end do
+ 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
- else
- if (set%mode_extrun.eq.p_ext_gfnff) then
- scale_factor = 1.03_wp
+ 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
- scale_factor = 1.0_wp
+ if (set%mode_extrun == p_ext_gfnff) then
+ scale_factor = 1.03_wp
+ else
+ scale_factor = 1.0_wp
+ end if
end if
- end if
- nvib=0
- nimag=0
-
- call axis2(nat,at,xyz,aa,bb,cc,avmom,wt)
-
- nvib_theo=3*nat-6
- if(cc.lt.1.d-10) linear=.true.
- if(linear) nvib_theo=3*nat-5
-
- if(aa+bb+cc.lt.1.d-6)then
- atom=.true.
- nvib=0
- nvib_theo=0
- endif
-
- ! the rotational number
- call getsymmetry(pr,iunit,nat,at,xyz,set%desy,set%maxatdesy,set%pgroup)
- call getsymnum(set%pgroup,linear,symnum)
-
- 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)
- endif
- enddo
-
- ! scale
- vibs(1:nvib)=vibs(1:nvib)*scale_factor
-
- 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)
- endif
- enddo
- 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
- endif
- vibs(nvib)=tmp(i)*rcmtoau ! work in atomic units, seriously
- else
- j=j+1
- endif
- enddo
- 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("."),":")')
- endif
-
- 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)
- enddo
-
- 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)')
- endif
- enddo
- write(iunit,'(3x,72("-"))')
-
- gtot = gt(set%nthermo)
- htot = et(set%nthermo)
-
- 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 :: i
- real(wp) :: maxfreq,omega,lnq_r,lnq_v,fswitch
-
- 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
- enddo
- write(iunit,'(3x,72("-"))')
-
-end subroutine print_thermo_sthr_lnq
-
-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
+ nvib = 0
+ nimag = 0
- 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)')
- 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
- endif
- ! 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)
- enddo
- write(iunit,'(3x,72("-"))')
-
-end subroutine print_thermo_sthr_ts
-
-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
-
- integer :: i
-
- 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)
+ call axis2(nat, at, xyz, aa, bb, cc, avmom, wt)
+
+ nvib_theo = 3 * nat - 6
+ if (cc < 1.d-10) linear = .true.
+ if (linear) nvib_theo = 3 * nat - 5
+
+ if (aa + bb + cc < 1.d-6) then
+ atom = .true.
+ nvib = 0
+ nvib_theo = 0
+ end if
+
+ ! the rotational number
+ call getsymmetry(pr, iunit, nat, at, xyz, set%desy, set%maxatdesy, set%pgroup)
+ call getsymnum(set%pgroup, linear, symnum)
+
+ vibs = 0
+ do i = 1, 3 * nat
+ if (abs(freq(i)) > vibthr .and. i <= nvib_in) then
+ nvib = nvib + 1
+ vibs(nvib) = freq(i)
+ end if
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
+
+ ! scale
+ vibs(1:nvib) = vibs(1:nvib) * scale_factor
+
+ do i = 1, nvib
+ ! artifacts
+ if (vibs(i) < 0 .and. vibs(i) > ithr) then
+ vibs(i) = -vibs(i)
+ if (pr) write (iunit, *) 'inverting freq ', i, vibs(i)
+ end if
end do
- end if
- write(iunit,'(/,1x,"total SASA / Ų :",f13.3)') &
- & sum(gbsa%sasa)*fourpi*autoaa**2
+ tmp = vibs
+
+ k = nvib
+ nvib = 0
+ j = 0
+ diff = abs(maxval(vibs) - set%thermo_sthr)
+ do i = 1, k
+ if (tmp(i) > 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
+ 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 == 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
+
+ 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
-end subroutine print_gbsa_info
+ 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 == set%nthermo .and. set%nthermo > 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, '(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 :: i
+ real(wp) :: maxfreq, omega, lnq_r, lnq_v, fswitch
+
+ 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_lnq
+
+ 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, 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)')
+ 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 > 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("-"))')
+
+ end subroutine print_thermo_sthr_ts
+
+ 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
+
+ integer :: i
+
+ 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
+ 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
+ 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
+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
+ 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)') "...","...","...","..."
- endif
- do iorb = minorb,maxorb
- call write_line(iorb,wfn%focc,wfn%emo,wfn%ihomo)
- enddo
- if (maxorb .lt. wfn%nao) then
- if (maxorb .lt. wfn%nao-1) then
+ 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 > 1) then
+ call write_line(1, wfn%focc, wfn%emo, wfn%ihomo)
+ if (minorb > 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 < wfn%nao) then
+ if (maxorb < wfn%nao - 1) then
if (wfn%focc(maxorb) > 1.0e-7_wp) then
- write(iunit,'(a10,a14,a21,a21)') "...","...","...","..."
+ write (iunit, '(a10,a14,a21,a21)') "...", "...", "...", "..."
else
- write(iunit,'(a10,a14,a21,a21)') "...", "","...","..."
- endif
- endif
- call write_line(wfn%nao,wfn%focc,wfn%emo,wfn%ihomo)
- endif
- 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
+ write (iunit, '(a10,a14,a21,a21)') "...", "", "...", "..."
+ end if
+ 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
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)
- endif
- if (iorb == ihomo) then
- write(iunit,'(1x,"(HOMO)")')
- elseif (iorb == ihomo+1) then
- write(iunit,'(1x,"(LUMO)")')
- else
- write(iunit,'(a)')
- endif
-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 f4f5626b5..c6d5df128 100644
--- a/src/main/setup.f90
+++ b/src/main/setup.f90
@@ -17,24 +17,24 @@
!> TODO
module xtb_main_setup
- use xtb_mctc_accuracy, only : wp
- use xtb_solv_input, only : TSolvInput
- use xtb_solv_model, only : init
- use xtb_extern_orca, only : TOrcaCalculator, newOrcaCalculator
- use xtb_extern_mopac, only : TMopacCalculator, newMopacCalculator
- use xtb_extern_turbomole, only : TTMCalculator, newTMCalculator
- use xtb_extern_driver, only : TDriverCalculator, newDriverCalculator
- use xtb_tblite_calculator, only : TTBLiteCalculator, TTBLiteInput, newTBLiteCalculator
- use xtb_type_calculator, only : TCalculator
- use xtb_type_environment, only : TEnvironment
- use xtb_type_molecule, only : TMolecule
- use xtb_type_restart, only : TRestart
- use xtb_type_wavefunction, only : TWavefunction
- use xtb_xtb_calculator, only : TxTBCalculator, newXTBcalculator, newWavefunction
- use xtb_gfnff_calculator, only : TGFFCalculator, newGFFCalculator
- use xtb_iff_calculator, only : TIFFCalculator, newIFFCalculator
- use xtb_iff_data, only : TIFFData
- use xtb_oniom, only : TOniomCalculator, newOniomCalculator, oniom_input
+ use xtb_mctc_accuracy, only: wp
+ use xtb_solv_input, only: TSolvInput
+ use xtb_solv_model, only: init
+ use xtb_extern_orca, only: TOrcaCalculator, newOrcaCalculator
+ use xtb_extern_mopac, only: TMopacCalculator, newMopacCalculator
+ use xtb_extern_turbomole, only: TTMCalculator, newTMCalculator
+ use xtb_extern_driver, only: TDriverCalculator, newDriverCalculator
+ use xtb_tblite_calculator, only: TTBLiteCalculator, TTBLiteInput, newTBLiteCalculator
+ use xtb_type_calculator, only: TCalculator
+ use xtb_type_environment, only: TEnvironment
+ use xtb_type_molecule, only: TMolecule
+ use xtb_type_restart, only: TRestart
+ use xtb_type_wavefunction, only: TWavefunction
+ use xtb_xtb_calculator, only: TxTBCalculator, newXTBcalculator, newWavefunction
+ use xtb_gfnff_calculator, only: TGFFCalculator, newGFFCalculator
+ use xtb_iff_calculator, only: TIFFCalculator, newIFFCalculator
+ use xtb_iff_data, only: TIFFData
+ use xtb_oniom, only: TOniomCalculator, newOniomCalculator, oniom_input
use xtb_setparam
implicit none
private
@@ -42,186 +42,182 @@ module xtb_main_setup
public :: newCalculator, newWavefunction, addSolvationModel
public :: newXTBCalculator
-
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(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
-
- logical :: exitRun
-
- 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_eht, p_ext_xtb)
- allocate(xtb)
-
- 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
+ logical :: exitRun
- 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)
+ select case (set%mode_extrun)
+ case default
+ call env%error("Unknown calculator type", source)
- call newTBLiteCalculator(env, mol, tblite, tblite_input)
+ 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)
- call env%check(exitRun)
- if (exitRun) then
- call env%error("Could not construct new calculator", source)
- return
- end if
+ case (p_ext_eht, p_ext_xtb)
+ allocate (xtb)
- call move_alloc(tblite, calc)
- case(p_ext_gfnff)
- allocate(gfnff)
+ call newXTBCalculator(env, mol, xtb, fname, set%gfn_method, accuracy)
- 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(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(gfnff, calc)
- case(p_ext_mcgfnff)
- allocate(gfnff)
+ call newTBLiteCalculator(env, mol, tblite, tblite_input)
- call newGFFCalculator(env, mol, gfnff, fname, restart, 4) ! mcgfnff2023 version
+ 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(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 newGFFCalculator(env, mol, gfnff, fname, restart)
- 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 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_mcgfnff)
+ allocate (gfnff)
+
+ call newGFFCalculator(env, mol, gfnff, fname, restart, 4) ! mcgfnff2023 version
+
+ call env%check(exitRun)
+ if (exitRun) then
+ call env%error("Could not construct new calculator", source)
+ return
+ end if
- call move_alloc(iff, calc)
-
- ! ORCA => https://orcaforum.kofo.mpg.de/app.php/portal !
- 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 = xtb%xtbData%level
+ 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
+
+ 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 move_alloc(iff, calc)
+
+ ! ORCA => https://orcaforum.kofo.mpg.de/app.php/portal !
+ 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 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
+ 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 = 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 (calc%lSolv) then
- allocate(calc%solvation)
- call init(calc%solvation, env, input, level)
- endif
+ 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/makel.f90 b/src/makel.f90
index 49dcbf4db..506d4f567 100644
--- a/src/makel.f90
+++ b/src/makel.f90
@@ -15,7 +15,6 @@
! You should have received a copy of the GNU Lesser General Public License
! along with xtb. If not, see .
-
!**********************************************************************
! *
! make the loewdin orthogonalization matrix x = u' s1/2 u *
@@ -23,89 +22,88 @@
! *
!**********************************************************************
-subroutine makel(nao, s, can, clo )
- use xtb_mctc_lapack, only : lapack_syev
- use xtb_mctc_blas, only : blas_gemm
- implicit real*8 (a-h,o-z)
- dimension s(nao,nao)
- dimension can(nao,nao)
- dimension clo(nao,nao)
- real*8, allocatable ::aux(:),vecs(:,:),e(:),cc(:,:),x(:,:)
+subroutine makel(nao, s, can, clo)
+ use xtb_mctc_lapack, only: lapack_syev
+ use xtb_mctc_blas, only: blas_gemm
+ implicit real * 8(a - h, o - z)
+ dimension s(nao, nao)
+ dimension can(nao, nao)
+ dimension clo(nao, nao)
+ real*8, allocatable :: aux(:), vecs(:, :), e(:), cc(:, :), x(:, :)
- lwork = 1 + 6*nao + 2*nao**2
- allocate (vecs(nao,nao),e(nao),aux(lwork),cc(nao,nao))
- allocate (x (nao,nao))
+ lwork = 1 + 6 * nao + 2 * nao**2
+ allocate (vecs(nao, nao), e(nao), aux(lwork), cc(nao, nao))
+ allocate (x(nao, nao))
vecs = s
- call lapack_syev ('V','U',nao,vecs,nao,e,aux,lwork,info)
+ call lapack_syev('V', 'U', nao, vecs, nao, e, aux, lwork, info)
- do i=1,nao
- if(e(i).lt.0) stop 'sorry, must stop in S^1/2!'
- e(i)=dsqrt(e(i))
- enddo
+ do i = 1, nao
+ if (e(i) < 0) stop 'sorry, must stop in S^1/2!'
+ e(i) = dsqrt(e(i))
+ end do
- do m=1,nao
- do i=1,nao
- x (i,m)= vecs(i,m)
- cc(i,m)=e(m)*vecs(i,m)
- enddo
- enddo
+ do m = 1, nao
+ do i = 1, nao
+ x(i, m) = vecs(i, m)
+ cc(i, m) = e(m) * vecs(i, m)
+ end do
+ end do
- call blas_gemm('N','T',nao,nao,nao,1.0d0,x, nao,cc,nao,0.0d0,vecs,nao)
+ call blas_gemm('N', 'T', nao, nao, nao, 1.0d0, x, nao, cc, nao, 0.0d0, vecs, nao)
x = vecs
- deallocate(e,aux,cc,vecs)
+ deallocate (e, aux, cc, vecs)
- moci=nao
- call blas_gemm('n','n',nao,moci,nao,1.d0,x,nao,can,nao,0.d0,clo,nao)
+ moci = nao
+ call blas_gemm('n', 'n', nao, moci, nao, 1.d0, x, nao, can, nao, 0.d0, clo, nao)
- deallocate(x)
+ deallocate (x)
return
end subroutine makel
-
! unrestricted version
-subroutine umakel(nao, s, cana, canb, cloa, clob )
- use xtb_mctc_lapack, only : lapack_syev
- use xtb_mctc_blas, only : blas_gemm
- implicit real*8 (a-h,o-z)
- dimension s(nao,nao)
- dimension cana(nao,nao)
- dimension cloa(nao,nao)
- dimension canb(nao,nao)
- dimension clob(nao,nao)
- real*8, allocatable ::aux(:),vecs(:,:),e(:),cc(:,:),x(:,:)
-
- lwork = 1 + 6*nao + 2*nao**2
- allocate (vecs(nao,nao),e(nao),aux(lwork),cc(nao,nao))
- allocate (x (nao,nao))
+subroutine umakel(nao, s, cana, canb, cloa, clob)
+ use xtb_mctc_lapack, only: lapack_syev
+ use xtb_mctc_blas, only: blas_gemm
+ implicit real * 8(a - h, o - z)
+ dimension s(nao, nao)
+ dimension cana(nao, nao)
+ dimension cloa(nao, nao)
+ dimension canb(nao, nao)
+ dimension clob(nao, nao)
+ real*8, allocatable :: aux(:), vecs(:, :), e(:), cc(:, :), x(:, :)
+
+ lwork = 1 + 6 * nao + 2 * nao**2
+ allocate (vecs(nao, nao), e(nao), aux(lwork), cc(nao, nao))
+ allocate (x(nao, nao))
vecs = s
- call lapack_syev ('V','U',nao,vecs,nao,e,aux,lwork,info)
+ call lapack_syev('V', 'U', nao, vecs, nao, e, aux, lwork, info)
- do i=1,nao
- if(e(i).lt.0) stop 'sorry, must stop in S^1/2!'
- e(i)=dsqrt(e(i))
- enddo
+ do i = 1, nao
+ if (e(i) < 0) stop 'sorry, must stop in S^1/2!'
+ e(i) = dsqrt(e(i))
+ end do
- do m=1,nao
- do i=1,nao
- x (i,m)= vecs(i,m)
- cc(i,m)=e(m)*vecs(i,m)
- enddo
- enddo
+ do m = 1, nao
+ do i = 1, nao
+ x(i, m) = vecs(i, m)
+ cc(i, m) = e(m) * vecs(i, m)
+ end do
+ end do
- call blas_gemm('N','T',nao,nao,nao,1.0d0,x,nao,cc,nao,0.0d0,vecs,nao)
+ call blas_gemm('N', 'T', nao, nao, nao, 1.0d0, x, nao, cc, nao, 0.0d0, vecs, nao)
x = vecs
- deallocate(e,aux,cc,vecs)
+ deallocate (e, aux, cc, vecs)
- moci=nao
- call blas_gemm('n','n',nao,moci,nao,1.d0,x,nao,cana,nao,0.d0,cloa,nao)
- call blas_gemm('n','n',nao,moci,nao,1.d0,x,nao,canb,nao,0.d0,clob,nao)
+ moci = nao
+ call blas_gemm('n', 'n', nao, moci, nao, 1.d0, x, nao, cana, nao, 0.d0, cloa, nao)
+ call blas_gemm('n', 'n', nao, moci, nao, 1.d0, x, nao, canb, nao, 0.d0, clob, nao)
- deallocate(x)
+ deallocate (x)
return
end subroutine umakel
diff --git a/src/prog/main.F90 b/src/prog/main.F90
index e7a178fe4..a5d717efc 100644
--- a/src/prog/main.F90
+++ b/src/prog/main.F90
@@ -16,8 +16,8 @@
! along with xtb. If not, see .
module xtb_prog_main
- use xtb_mctc_accuracy, only : wp
- use xtb_mctc_io, only : stderr
+ use xtb_mctc_accuracy, only: wp
+ use xtb_mctc_io, only: stderr
use xtb_mctc_timings
use xtb_mctc_systools
use xtb_mctc_convert
@@ -25,10 +25,10 @@ module xtb_prog_main
use xtb_type_molecule
use xtb_type_calculator
use xtb_type_restart
- use xtb_tblite_restart, only : loadRestart, dumpRestart
+ use xtb_tblite_restart, only: loadRestart, dumpRestart
use xtb_type_param
use xtb_type_data
- use xtb_type_environment, only : TEnvironment, init
+ use xtb_type_environment, only: TEnvironment, init
use xtb_prog_argparser
use xtb_solv_state
use xtb_setparam
@@ -36,1920 +36,1896 @@ module xtb_prog_main
use xtb_scanparam
use xtb_splitparam
use xtb_fixparam
- use xtb_features, only : get_xtb_feature
- use xtb_constrain_param, only : read_userdata
+ use xtb_features, only: get_xtb_feature
+ use xtb_constrain_param, only: read_userdata
use xtb_shake, only: init_shake
use xtb_gfnff_shake, only: gff_init_shake => init_shake
- use xtb_embedding, only : init_pcem
- use xtb_io_reader, only : readMolecule
- use xtb_io_writer, only : writeMolecule
- use xtb_mctc_filetypes, only : fileType, getFileType, generateFileMetaInfo, &
+ use xtb_embedding, only: init_pcem
+ use xtb_io_reader, only: readMolecule
+ use xtb_io_writer, only: writeMolecule
+ use xtb_mctc_filetypes, only: fileType, getFileType, generateFileMetaInfo, &
& generateFileName
use xtb_readin
use xtb_printout
use xtb_setmod
use xtb_propertyoutput
- use xtb_io_writer_turbomole, only : writeResultsTurbomole
- use xtb_io_writer_orca, only : writeResultsOrca
- use xtb_io_writer_gaussian, only : writeResultsGaussianExternal
+ use xtb_io_writer_turbomole, only: writeResultsTurbomole
+ use xtb_io_writer_orca, only: writeResultsOrca
+ use xtb_io_writer_gaussian, only: writeResultsGaussianExternal
use xtb_restart
use xtb_readparam
- use xtb_scc_core, only : iniqshell
- use xtb_aespot, only : get_radcn
- use xtb_iniq, only : iniqcn
+ use xtb_scc_core, only: iniqshell
+ use xtb_aespot, only: get_radcn
+ use xtb_iniq, only: iniqcn
use xtb_eeq
- use xtb_disp_ncoord, only : ncoord_gfn, dncoord_erf, dncoord_d3, ncoord_erf, &
+ use xtb_disp_ncoord, only: ncoord_gfn, dncoord_erf, dncoord_d3, ncoord_erf, &
& ncoord_d3
use xtb_basis
- use xtb_axis, only : axis3
- use xtb_hessian, only : numhess
- use xtb_dynamic, only : md
- use xtb_modef, only : modefollow
- use xtb_mdoptim, only : mdopt
- use xtb_screening, only : screen
+ use xtb_axis, only: axis3
+ use xtb_hessian, only: numhess
+ use xtb_dynamic, only: md
+ use xtb_modef, only: modefollow
+ use xtb_mdoptim, only: mdopt
+ use xtb_screening, only: screen
use xtb_xtb_calculator
use xtb_gfnff_calculator
- use xtb_iff_calculator, only : TIFFCalculator
+ use xtb_iff_calculator, only: TIFFCalculator
use xtb_paramset
use xtb_xtb_gfn0
use xtb_xtb_gfn1
use xtb_xtb_gfn2
use xtb_main_setup
- use xtb_main_defaults, only : initDefaults
- use xtb_main_json, only : main_json, write_json_gfnff_lists
+ use xtb_main_defaults, only: initDefaults
+ use xtb_main_json, only: main_json, write_json_gfnff_lists
use xtb_geoopt
use xtb_metadynamic
use xtb_biaspath
use xtb_coffee
use xtb_disp_dftd3param
use xtb_disp_dftd4
- use xtb_gfnff_param, only : gff_print
- use xtb_gfnff_topology, only : TPrintTopo
- use xtb_gfnff_convert, only : struc_convert
+ use xtb_gfnff_param, only: gff_print
+ use xtb_gfnff_topology, only: TPrintTopo
+ use xtb_gfnff_convert, only: struc_convert
use xtb_scan
use xtb_kopt
- use xtb_iff_iffprepare, only : prepare_IFF
- use xtb_iff_data, only : TIFFData
- use xtb_oniom, only : oniom_input, TOniomCalculator, calculateCharge
- use xtb_vertical, only : vfukui
- use xtb_tblite_calculator, only : TTBLiteCalculator, TTBLiteInput, newTBLiteWavefunction
+ use xtb_iff_iffprepare, only: prepare_IFF
+ use xtb_iff_data, only: TIFFData
+ use xtb_oniom, only: oniom_input, TOniomCalculator, calculateCharge
+ use xtb_vertical, only: vfukui
+ use xtb_tblite_calculator, only: TTBLiteCalculator, TTBLiteInput, newTBLiteWavefunction
use xtb_solv_cpx, only: TCpcmx
- use xtb_dipro, only: get_jab,jab_input
-
+ use xtb_dipro, only: get_jab, jab_input
+
implicit none
private
public :: xtbMain
-
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'
-
- 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'
+
+ 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),nums(3,3),eps(3,3),latt(3,3)
+ logical, parameter :: gen_param = .false.
+ logical, parameter :: debug = .false.
+ type(TRestart) :: wf0
+ real(wp), allocatable :: coord(:, :), numg(:, :), gdum(:, :)
+ real(wp) :: sdum(3, 3), nums(3, 3), eps(3, 3), latt(3, 3)
- real(wp),parameter :: step = 0.00001_wp, step2 = 0.5_wp/step ! for numerical gradient
- real(wp),parameter :: sstep = 1.0_wp*10.0_wp**(-6), sstep2 = 0.5_wp/sstep ! for numerical sigma
- real(wp) :: er,el
- logical :: coffee ! if debugging gets really though, get a coffee
+ real(wp), parameter :: step = 0.00001_wp, step2 = 0.5_wp / step ! for numerical gradient
+ real(wp), parameter :: sstep = 1.0_wp * 10.0_wp**(-6), sstep2 = 0.5_wp / sstep ! for numerical sigma
+ 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
+ integer :: TID, OMP_GET_NUM_THREADS, OMP_GET_THREAD_NUM
+ integer :: nproc
- type(TPrintTopo) :: printTopo ! gfnff topology printout list
+ type(TPrintTopo) :: printTopo ! gfnff topology printout list
- xenv%home = env%xtbhome
- xenv%path = env%xtbpath
+ xenv%home = env%xtbhome
+ xenv%path = env%xtbpath
+ ! ------------------------------------------------------------------------
+ !> read the command line arguments
- ! ------------------------------------------------------------------------
- !> read the command line arguments
-
- call parseArguments(env, argParser, xcontrol, fnv, lgrad, &
- & restart, gsolvstate, strict, copycontrol, coffee, printTopo, oniom, dipro, tblite)
+ 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)
- endif
+ !> Spin-polarization is only available in the tblite library
+ if (set%mode_extrun /= 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
+ 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
+ call argParser%nextFile(fname)
+ end select
- 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'
+ if (.not. allocated(xcontrol)) then
+ if (copycontrol) then
+ xcontrol = 'xtb.inp'
+ else
+ xcontrol = fname
+ end if
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
- call argParser%nextFile(fname)
- end select
- if (.not.allocated(xcontrol)) then
- if (copycontrol) then
- xcontrol = 'xtb.inp'
- else
- xcontrol = fname
+ anyopt = ((set%runtyp == p_run_opt) .or. (set%runtyp == p_run_ohess) .or. &
+ & (set%runtyp == p_run_omd) .or. (set%runtyp == p_run_screen) .or. &
+ & (set%runtyp == 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.")
+
+ 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 /= -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
- 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))
-
- 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.")
-
- 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)
+
+ call env%checkpoint("Reading charge from file failed")
+
+ !> Number of unpaired electrons
+ call open_file(ich, '.UHF', 'r')
+ if (ich /= -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
+
+ !> efield read: gfnff only
+ call open_file(ich, '.EFIELD', 'r')
+ if (ich /= -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
- call env%checkpoint("Reading charge from file failed")
+ call env%checkpoint("Reading multiplicity from file failed")
- !> 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)
+ ! ------------------------------------------------------------------------
+ !> 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 set_spin(env,cdum)
+ 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 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
- endif
-
- !> efield read: gfnff only
- 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)
+
+ ! ------------------------------------------------------------------------
+ !> 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 == p_run_bhess) then
+ call init_bhess(mol%n)
else
- call set_efield(env,cdum)
- call close_file(ich)
+ 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
+ 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) > 57 .and. mol%at(i) < 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
- endif
-
- 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")
- endif
-
- ! ------------------------------------------------------------------------
- !> 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)
+
+ 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 env%warning("Two dimensional input structure detected", source)
+ 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
- ! 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)
+ ! ------------------------------------------------------------------------
+ !> CONSTRAINTS & SCANS
+ !> now we are at a point that we can check for requested constraints
+ call read_userdata(xcontrol, env, mol)
+
+ !> 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 == 0 .and. iatf2 == 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 == 3) then
+ call env%terminate('This is an internal error, please use gfn_method=2!')
+ end if
+
+ ! ------------------------------------------------------------------------
+ !> Print the method header and select the parameter file
+
+ if (.not. allocated(fnv)) 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 == p_ext_gfnff) then
+ fnv = xfind(p_fname_param_gfnff)
+ else
+ if (set%gfn_method == 0) then
+ fnv = xfind(p_fname_param_gfn0)
+ end if
+ if (set%gfn_method == 1) then
+ fnv = xfind(p_fname_param_gfn1)
+ end if
+ if (set%gfn_method == 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)
+ if (set%gfn_method == 0) then
+ fnv = xfind(p_fname_param_gfn0)
+ end if
+ if (set%gfn_method == 1) then
+ fnv = xfind(p_fname_param_gfn1)
+ end if
+ if (set%gfn_method == 2) then
+ fnv = xfind(p_fname_param_gfn2)
+ end if
+ end select
+ 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 < 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
+ if (mol%npbc > 0) then
+ chk%wfn%q = real(set%ichrg, wp) / real(mol%n, wp)
else
- set%ichrg = nint(mol%chrg)
+ if (set%guess_charges == 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 == 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
+
+ ! ------------------------------------------------------------------------
+ !> printout a header for the exttyp
+ call calc%writeInfo(env%unit, mol)
+
+ call delete_file('.sccnotconverged')
+
+ call env%checkpoint("Setup for calculation failed")
+
+ 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)
+ 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
+ !-------------------------------------------------------------------------
+ !> DIPRO calculation of coupling integrals for dimers
+ if (dipro%diprocalc) then
+ call start_timing(11)
+ call get_jab(env, tblite, mol, splitlist, dipro)
+ call env%checkpoint("Something in your DIPRO calculation went wrong.")
+ call stop_timing_run
+ call stop_timing(11)
+ write (*, '(A)') "----------------------------------------------------------"
+ call prdate('E')
+ write (*, '(A)') "----------------------------------------------------------"
+ call prtiming(11, 'dipro')
+ call terminate(0)
end if
- call env%checkpoint("reading geometry input '"//fname//"' failed")
- endif
-
- ! ------------------------------------------------------------------------
- !> 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)
- endif
- endif
-
- 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
- enddo
-
- !> 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)
- endif
-
- 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)
-
- !> 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)
- endif
- ! 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)
- endif
- 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)
- endif
-
- ! ------------------------------------------------------------------------
- !> write copy of detailed input
- if (copycontrol) then
- call open_set(ictrl,xcontrol)
- call write_set(ictrl)
- call close_set(ictrl)
- endif
-
- ! ------------------------------------------------------------------------
- !> 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)
- endif
- 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")
- endif
-
- !> check if someone is still using GFN3...
- if (set%gfn_method.eq.3) then
- call env%terminate('This is an internal error, please use gfn_method=2!')
- end if
-
- ! ------------------------------------------------------------------------
- !> Print the method header and select the parameter file
-
- if (.not.allocated(fnv)) 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)
- else
- if(set%gfn_method.eq.0) then
- fnv=xfind(p_fname_param_gfn0)
- endif
- if(set%gfn_method.eq.1) then
- fnv=xfind(p_fname_param_gfn1)
- endif
- if(set%gfn_method.eq.2) then
- fnv=xfind(p_fname_param_gfn2)
- endif
- 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)
- endif
- if(set%gfn_method.eq.1) then
- fnv=xfind(p_fname_param_gfn1)
- endif
- if(set%gfn_method.eq.2) then
- fnv=xfind(p_fname_param_gfn2)
- endif
+ ! ========================================================================
+ !> 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
- endif
-
- !-------------------------------------------------------------------------
- !> 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)
- endif
- 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
+ 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 == 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
- !> 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)
-
- call delete_file('.sccnotconverged')
-
- call env%checkpoint("Setup for calculation failed")
-
- 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.)
- endif
- 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"
+
+ ! ------------------------------------------------------------------------
+ !> 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
+ end do
+ print'(/,"numerical gradient")'
+ print *, numg
+ print'(/,"difference gradient")'
+ print *, g - numg
+ deallocate (coord)
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.)
- endif
- end select
- if (.not.set%oniom_settings%fixed_chrgs) then
- set%oniom_settings%innerchrg = calculateCharge(calc,env,mol,chk)
- endif
-
-
- end select
- !-------------------------------------------------------------------------
- !> DIPRO calculation of coupling integrals for dimers
- if (dipro%diprocalc) then
- call start_timing(11)
- call get_jab(env,tblite,mol,splitlist,dipro)
- call env%checkpoint("Something in your DIPRO calculation went wrong.")
- call stop_timing_run
- call stop_timing(11)
- write(*,'(A)') "----------------------------------------------------------"
- call prdate('E')
- write(*,'(A)') "----------------------------------------------------------"
- call prtiming(11,'dipro')
- 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)
- enddo
- enddo
- print'(/,"numerical gradient")'
- print *, numg
- print'(/,"difference gradient")'
- print*,g-numg
- deallocate(coord)
- endif
-
- !> numerical sigma (=volume*stressTensor) for debugging purposes
- if (debug.and.mol%npbc.eq.3) then
- ! generate a warning to keep release versions from calculating numerical gradients
- call env%warning('XTB IS CALCULATING NUMERICAL STRESS, RESET DEBUG FOR RELEASE!')
- print'(/,"analytical sigma")'
- print *, sigma
- if(.not.allocated(gdum)) allocate(gdum(3,mol%n), source = 0.0_wp )
- allocate( coord(3,mol%n), source = mol%xyz )
- latt=mol%lattice
- nums = 0.0_wp
- !sdum = 0.0_wp
- wf0 = chk
- do j = 1, 3
- do i = 1, j
- ! Only eps_ij=step the rest equals zero: eps_(kl.ne.ij)=0
- eps=0.0_wp
- eps(i,j)=sstep
- ! adjust position vectors and lattice to get er
- do k=1,3
- mol%xyz(k,:) = kron(k,1)*mol%xyz(1,:) + eps(k,1)*mol%xyz(1,:) + &
- & kron(k,2)*mol%xyz(2,:) + eps(k,2)*mol%xyz(2,:) + &
- & kron(k,3)*mol%xyz(3,:) + eps(k,3)*mol%xyz(3,:)
- mol%lattice(k,1) = (kron(k,1) + eps(k,1))*mol%lattice(1,1) + &
- & (kron(k,2) + eps(k,2))*mol%lattice(2,1) + &
- & (kron(k,3) + eps(k,3))*mol%lattice(3,1)
- mol%lattice(k,2) = (kron(k,1) + eps(k,1))*mol%lattice(1,2) + &
- & (kron(k,2) + eps(k,2))*mol%lattice(2,2) + &
- & (kron(k,3) + eps(k,3))*mol%lattice(3,2)
- mol%lattice(k,3) = (kron(k,1) + eps(k,1))*mol%lattice(1,3) + &
- & (kron(k,2) + eps(k,2))*mol%lattice(2,3) + &
- & (kron(k,3) + eps(k,3))*mol%lattice(3,3)
- enddo
- chk = wf0
- call calc%singlepoint(env,mol,chk,0,.true.,er,gdum,sdum,egap,res)
-
- ! reset coordinates and lattice
- mol%xyz=coord
- mol%lattice=latt
- ! adjust position vectors and lattice to get el
- do k=1,3
- mol%xyz(k,:) = kron(k,1)*mol%xyz(1,:) - eps(k,1)*mol%xyz(1,:) + &
- & kron(k,2)*mol%xyz(2,:) - eps(k,2)*mol%xyz(2,:) + &
- & kron(k,3)*mol%xyz(3,:) - eps(k,3)*mol%xyz(3,:)
- mol%lattice(k,1) = (kron(k,1) - eps(k,1))*mol%lattice(1,1) + &
- & (kron(k,2) - eps(k,2))*mol%lattice(2,1) + &
- & (kron(k,3) - eps(k,3))*mol%lattice(3,1)
- mol%lattice(k,2) = (kron(k,1) - eps(k,1))*mol%lattice(1,2) + &
- & (kron(k,2) - eps(k,2))*mol%lattice(2,2) + &
- & (kron(k,3) - eps(k,3))*mol%lattice(3,2)
- mol%lattice(k,3) = (kron(k,1) - eps(k,1))*mol%lattice(1,3) + &
- & (kron(k,2) - eps(k,2))*mol%lattice(2,3) + &
- & (kron(k,3) - eps(k,3))*mol%lattice(3,3)
- enddo
- chk = wf0
- call calc%singlepoint(env,mol,chk,0,.true.,el,gdum,sdum,egap,res)
-
- ! numerical sigma (=volume*stressTensor)
- nums(i,j) = sstep2 * (er - el) ! divide by 2 times step size
- nums(j,i) = nums(i,j) ! stress tensor is symmetric
- ! reset coordinates and lattice
- mol%xyz=coord
- mol%lattice=latt
- enddo
- enddo
-
- print'(/,"numerical sigma")'
- print *, nums
- print'(/,"difference sigma")'
- print*,sigma-nums
- deallocate(coord)
- endif
+ !> numerical sigma (=volume*stressTensor) for debugging purposes
+ if (debug .and. mol%npbc == 3) then
+ ! generate a warning to keep release versions from calculating numerical gradients
+ call env%warning('XTB IS CALCULATING NUMERICAL STRESS, RESET DEBUG FOR RELEASE!')
+ print'(/,"analytical sigma")'
+ print *, sigma
+ if (.not. allocated(gdum)) allocate (gdum(3, mol%n), source=0.0_wp)
+ allocate (coord(3, mol%n), source=mol%xyz)
+ latt = mol%lattice
+ nums = 0.0_wp
+ !sdum = 0.0_wp
+ wf0 = chk
+ do j = 1, 3
+ do i = 1, j
+ ! Only eps_ij=step the rest equals zero: eps_(kl.ne.ij)=0
+ eps = 0.0_wp
+ eps(i, j) = sstep
+ ! adjust position vectors and lattice to get er
+ do k = 1, 3
+ mol%xyz(k, :) = kron(k, 1) * mol%xyz(1, :) + eps(k, 1) * mol%xyz(1, :) + &
+ & kron(k, 2) * mol%xyz(2, :) + eps(k, 2) * mol%xyz(2, :) + &
+ & kron(k, 3) * mol%xyz(3, :) + eps(k, 3) * mol%xyz(3, :)
+ mol%lattice(k, 1) = (kron(k, 1) + eps(k, 1)) * mol%lattice(1, 1) + &
+ & (kron(k, 2) + eps(k, 2)) * mol%lattice(2, 1) + &
+ & (kron(k, 3) + eps(k, 3)) * mol%lattice(3, 1)
+ mol%lattice(k, 2) = (kron(k, 1) + eps(k, 1)) * mol%lattice(1, 2) + &
+ & (kron(k, 2) + eps(k, 2)) * mol%lattice(2, 2) + &
+ & (kron(k, 3) + eps(k, 3)) * mol%lattice(3, 2)
+ mol%lattice(k, 3) = (kron(k, 1) + eps(k, 1)) * mol%lattice(1, 3) + &
+ & (kron(k, 2) + eps(k, 2)) * mol%lattice(2, 3) + &
+ & (kron(k, 3) + eps(k, 3)) * mol%lattice(3, 3)
+ end do
+ chk = wf0
+ call calc%singlepoint(env, mol, chk, 0, .true., er, gdum, sdum, egap, res)
+
+ ! reset coordinates and lattice
+ mol%xyz = coord
+ mol%lattice = latt
+ ! adjust position vectors and lattice to get el
+ do k = 1, 3
+ mol%xyz(k, :) = kron(k, 1) * mol%xyz(1, :) - eps(k, 1) * mol%xyz(1, :) + &
+ & kron(k, 2) * mol%xyz(2, :) - eps(k, 2) * mol%xyz(2, :) + &
+ & kron(k, 3) * mol%xyz(3, :) - eps(k, 3) * mol%xyz(3, :)
+ mol%lattice(k, 1) = (kron(k, 1) - eps(k, 1)) * mol%lattice(1, 1) + &
+ & (kron(k, 2) - eps(k, 2)) * mol%lattice(2, 1) + &
+ & (kron(k, 3) - eps(k, 3)) * mol%lattice(3, 1)
+ mol%lattice(k, 2) = (kron(k, 1) - eps(k, 1)) * mol%lattice(1, 2) + &
+ & (kron(k, 2) - eps(k, 2)) * mol%lattice(2, 2) + &
+ & (kron(k, 3) - eps(k, 3)) * mol%lattice(3, 2)
+ mol%lattice(k, 3) = (kron(k, 1) - eps(k, 1)) * mol%lattice(1, 3) + &
+ & (kron(k, 2) - eps(k, 2)) * mol%lattice(2, 3) + &
+ & (kron(k, 3) - eps(k, 3)) * mol%lattice(3, 3)
+ end do
+ chk = wf0
+ call calc%singlepoint(env, mol, chk, 0, .true., el, gdum, sdum, egap, res)
+
+ ! numerical sigma (=volume*stressTensor)
+ nums(i, j) = sstep2 * (er - el) ! divide by 2 times step size
+ nums(j, i) = nums(i, j) ! stress tensor is symmetric
+ ! reset coordinates and lattice
+ mol%xyz = coord
+ mol%lattice = latt
+ end do
+ end do
+
+ print'(/,"numerical sigma")'
+ print *, nums
+ print'(/,"difference sigma")'
+ print *, sigma - nums
+ deallocate (coord)
+ end if
!---------------------------------------------!
-! Geometry optimization(ANCopt,L_ANCopt,FIRE) !
+! Geometry optimization(ANCopt,L_ANCopt,FIRE) !
!---------------------------------------------!
- if (anyopt) then
-
- if(mol%npbc.gt.0.and.(set%mode_extrun.eq.p_ext_gfnff &
- & .or.set%mode_extrun.eq.p_ext_mcgfnff)) then ! if(npbc)
- deallocate(set%opt_engine)
- call set_opt(env,'engine','pbc_lbfgs') ! use lbfgs
- endif
- if (set%opt_engine.eq.p_engine_rf) &
- call ancopt_header(env%unit,set%veryverbose)
+ if (anyopt) then
+
+ if (mol%npbc > 0 .and. (set%mode_extrun == p_ext_gfnff &
+ & .or. set%mode_extrun == p_ext_mcgfnff)) then ! if(npbc)
+ deallocate (set%opt_engine)
+ call set_opt(env, 'engine', 'pbc_lbfgs') ! use lbfgs
+ end if
+ if (set%opt_engine == p_engine_rf) &
+ call ancopt_header(env%unit, set%veryverbose)
!! Print ANCopt header
-
- ! start optimization timer !
- call start_timing(3)
-
- ! calculation !
- call geometry_optimization &
- & (env, mol,chk,calc, &
- & egap,set%etemp,set%maxscciter,set%optset%maxoptcycle,etot,g,sigma,set%optset%optlev,.true.,.false.,murks)
-
- ! save results !
- res%e_total = etot
- res%gnorm = norm2(g)
-
- ! constrained optimization !
- if (nscan.gt.0) then
- call relaxed_scan(env,mol,chk,calc)
- endif
-
- ! in case of failure cretae xtblast geometry !
- if (murks) then
- call generateFileName(tmpname, 'xtblast', extension, mol%ftype)
- write(env%unit,'(/,a,1x,a,/)') &
- "last 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)
- call env%terminate("Geometry optimization failed")
+
+ ! start optimization timer !
+ call start_timing(3)
+
+ ! calculation !
+ call geometry_optimization &
+ & (env, mol, chk, calc, &
+ & egap,set%etemp,set%maxscciter,set%optset%maxoptcycle,etot,g,sigma,set%optset%optlev,.true.,.false.,murks)
+
+ ! save results !
+ res%e_total = etot
+ res%gnorm = norm2(g)
+
+ ! constrained optimization !
+ if (nscan > 0) then
+ call relaxed_scan(env, mol, chk, calc)
+ end if
+
+ ! in case of failure cretae xtblast geometry !
+ if (murks) then
+ call generateFileName(tmpname, 'xtblast', extension, mol%ftype)
+ write (env%unit, '(/,a,1x,a,/)') &
+ "last 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)
+ call env%terminate("Geometry optimization failed")
+ end if
+
+ ! stop optimization timer !
+ call stop_timing(3)
+
end if
- ! stop optimization timer !
- call stop_timing(3)
+ ! ------------------------------------------------------------------------
+ !> automatic VIP and VEA single point (maybe after optimization)
+ if (set%runtyp == p_run_vip .or. set%runtyp == p_run_vipea &
+ & .or. set%runtyp == 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) /= 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
- endif
+ if (set%runtyp == p_run_vea .or. set%runtyp == p_run_vipea &
+ & .or. set%runtyp == 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) /= 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 == 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)
- endif
+ ! ------------------------------------------------------------------------
+ !> Fukui Index from Mulliken population analysis
+ if (set%runtyp == 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("-"))')
-
- mol%chrg = mol%chrg + 1
- chk%wfn%nel = chk%wfn%nel-1
- call stop_timing(2)
- endif
-
-
- ! ------------------------------------------------------------------------
- !> 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("-"))')
- endif
-
-
- ! ------------------------------------------------------------------------
- !> 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)
- endif
-
-
- ! ------------------------------------------------------------------------
- !> 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)
+ ! ------------------------------------------------------------------------
+ !> numerical hessian calculation
+ if ((set%runtyp == p_run_hess) .or. (set%runtyp == p_run_ohess) .or. (set%runtyp == p_run_bhess)) then
+ if (set%runtyp == p_run_bhess .and. set%mode_extrun /= p_ext_turbomole) then
+ call generic_header(env%unit, "Biased Numerical Hessian", 49, 10)
+ else if (set%runtyp == p_run_bhess .and. set%mode_extrun == p_ext_turbomole) then
+ call generic_header(env%unit, "Biased Analytical TM Hessian", 49, 10)
+ else if (set%mode_extrun == 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)
+
+ call env%checkpoint("Hessian calculation terminated")
end if
- if (mol%npbc > 0) then
- call env%error("Phonon calculations under PBC are not implemented", source)
- endif
- 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")
- endif
-
- ! 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
+
+ ! 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
- end if
- call env%checkpoint("Calculation terminated")
+ !> 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 /= 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
- ! ========================================================================
- !> 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')
- endif
- else
- iprop = env%unit
- endif
-
- 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'
+ call env%checkpoint("Calculation terminated")
+
+ ! ========================================================================
+ !> PRINTOUT SECTION
+ if (allocated(set%property_file)) then
+ call open_file(iprop, set%property_file, 'w')
+ if (iprop == -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 == 0) &
+ write (iprop, '("hostname: ''",a,"''")') cdum
+ write (iprop, '("date: ",a)') prtimestring('S')
+ end if
else
- cdum = 'xtb-orca.engrad'
+ 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
+ call open_file(ich, cdum, 'w')
+ call writeResultsOrca(ich, mol, etot, g)
+ call close_file(ich)
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'
+ if (mol%ftype == 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)
+ end if
+
+ if (set%periodic) then
+ write (*, *) 'Periodic properties'
else
- cdum = 'xtb-gaussian.EOu'
+ 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)
+ end select
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)
- end select
- endif
-
- if (set%pr_json) then
- select type(calc)
- type is(TxTBCalculator)
- call open_file(ich,'xtbout.json','w')
- call main_json(ich, &
- mol,chk%wfn,calc%basis,res,fres)
+
+ if (set%pr_json) then
+ select type (calc)
+ type is (TxTBCalculator)
+ call open_file(ich, 'xtbout.json', 'w')
+ call main_json(ich, &
+ mol, chk%wfn, calc%basis, res, fres)
+ 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, calc%neigh, chk%nlist, printTopo)
+ end select
+ end if
+ if ((set%runtyp == p_run_opt) .or. (set%runtyp == p_run_ohess) .or. &
+ (set%runtyp == p_run_omd) .or. (set%runtyp == p_run_screen) .or. &
+ (set%runtyp == p_run_metaopt) .or. (set%runtyp == p_run_bhess)) then
+ call main_geometry(iprop, mol)
+ end if
+
+ if ((set%runtyp == p_run_hess) .or. (set%runtyp == p_run_ohess) .or. (set%runtyp == 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 /= -1 .and. iprop /= env%unit) then
+ call write_energy(iprop, res, fres, &
+ & (set%runtyp == p_run_hess) .or. (set%runtyp == p_run_ohess) .or. (set%runtyp == p_run_bhess))
+ call close_file(iprop)
+ end if
+ end if
+
+ if ((set%runtyp == p_run_opt) .or. (set%runtyp == p_run_ohess) .or. &
+ (set%runtyp == p_run_omd) .or. (set%runtyp == p_run_screen) .or. &
+ (set%runtyp == p_run_metaopt) .or. (set%runtyp == 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)
+ call write_energy(env%unit, res, fres, &
+ & (set%runtyp == p_run_hess) .or. (set%runtyp == p_run_ohess) .or. (set%runtyp == p_run_bhess))
+ type is (TOniomCalculator)
+ call write_energy_oniom(env%unit, res, fres, &
+ & (set%runtyp == p_run_hess) .or. (set%runtyp == p_run_ohess .or. (set%runtyp == p_run_bhess)))
+ class default
+ call write_energy_gff(env%unit, res, fres, &
+ & (set%runtyp == p_run_hess) .or. (set%runtyp == p_run_ohess) .or. (set%runtyp == p_run_bhess))
end select
- endif
- if(printTopo%any()) then
- select type(calc)
- type is(TGFFCalculator)
- call write_json_gfnff_lists(mol%n,res%e_total,res%gnorm,calc%topo,calc%neigh,chk%nlist,printTopo)
- end select
- endif
- 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)
- endif
-
- 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)
- endif
-
- 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)
- endif
- endif
-
- 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)
- endif
-
- select type(calc)
- type is(TxTBCalculator)
- call write_energy(env%unit,res,fres, &
- & (set%runtyp.eq.p_run_hess).or.(set%runtyp.eq.p_run_ohess).or.(set%runtyp.eq.p_run_bhess))
- type is(TOniomCalculator)
- call write_energy_oniom(env%unit,res,fres, &
- & (set%runtyp.eq.p_run_hess).or.(set%runtyp.eq.p_run_ohess.or.(set%runtyp.eq.p_run_bhess)))
- class default
- call write_energy_gff(env%unit,res,fres, &
- & (set%runtyp.eq.p_run_hess).or.(set%runtyp.eq.p_run_ohess).or.(set%runtyp.eq.p_run_bhess))
- 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
+
+ ! ------------------------------------------------------------------------
+ ! xtb molecular dynamics
+ if ((set%runtyp == p_run_md) .or. (set%runtyp == p_run_omd)) then
+ if (metaset%maxsave > 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 == p_run_metaopt) then
if (mol%npbc > 0) then
- call env%error("Metadynamic under PBC is not implemented", source)
- endif
+ call env%warning("Metadynamic under PBC is not implemented", source)
+ end if
call metadyn_header(env%unit)
- else
- call md_header(env%unit)
- endif
- 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)
- endif
-
-
- ! ------------------------------------------------------------------------
- ! metadynamics
- if (set%runtyp.eq.p_run_metaopt) then
- if (mol%npbc > 0) then
- call env%warning("Metadynamic under PBC is not implemented", source)
- endif
- call metadyn_header(env%unit)
- ! check if ANCOPT already convered
- if (murks) then
- call env%error('Optimization did not converge, aborting', source)
- endif
- 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
- enddo
- enddo
- 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
- endif
+ ! check if ANCOPT already convered
if (murks) then
- call close_file(ich)
- write(env%unit,'(/,3x,"***",1x,a,1x,"***",/)') &
- "FAILED TO CONVERGE GEOMETRY OPTIMIZATION"
- call touch_file('NOT_CONVERGED')
- endif
+ 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))
- enddo
- call close_file(ich)
- call stop_timing(6)
- endif
-
-
- ! ------------------------------------------------------------------------
- ! 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)
- endif
- call start_timing(4)
- call bias_path(env,mol,chk,calc,egap,set%etemp,set%maxscciter,etot,g,sigma)
- call stop_timing(4)
- endif
-
-
- ! ------------------------------------------------------------------------
- ! 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)
- endif
-
-
- ! ------------------------------------------------------------------------
- ! 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)
- endif
- call start_timing(9)
- call modefollow(env,mol,chk,calc,egap,set%etemp,set%maxscciter,etot,g,sigma)
- call stop_timing(9)
- endif
-
-
- ! ------------------------------------------------------------------------
- ! 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)
- endif
-
-
- ! ------------------------------------------------------------------------
- ! 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)
- endif
- 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)')
- write(env%unit,'(72("-"))')
- call print_filelist(env%unit)
- endif
-
-
- ! ------------------------------------------------------------------------
- ! 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')
- endif
- if (set%runtyp.eq.p_run_path) then
- call prtiming(4,'path finder')
- endif
- 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')
+ 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
- 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')
- endif
- if (set%runtyp.eq.p_run_screen) then
- call prtiming(8,'screen')
- endif
- if (set%runtyp.eq.p_run_modef) then
- call prtiming(9,'mode following')
- endif
- if (set%runtyp.eq.p_run_mdopt) then
- call prtiming(10,'MD opt.')
- endif
-
- write(env%unit,'(a)')
- call terminate(0)
-
-end subroutine xtbMain
+ ! ------------------------------------------------------------------------
+ ! path finder
+ if (set%runtyp == 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 == 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 == 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 == 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)')
+ 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 == p_run_opt) .or. (set%runtyp == p_run_ohess) .or. &
+ & (set%runtyp == p_run_omd) .or. (set%runtyp == p_run_metaopt)) then
+ call prtiming(3, 'ANC optimizer')
+ end if
+ if (set%runtyp == p_run_path) then
+ call prtiming(4, 'path finder')
+ end if
+ if (((set%runtyp == p_run_hess) .or. (set%runtyp == p_run_ohess) .or. (set%runtyp == p_run_bhess))) then
+ if (set%mode_extrun /= p_ext_turbomole) then
+ call prtiming(5, 'analytical hessian')
+ else
+ call prtiming(5, 'numerical hessian')
+ end if
+ end if
+ if ((set%runtyp == p_run_md) .or. (set%runtyp == p_run_omd) .or. &
+ (set%runtyp == p_run_metaopt)) then
+ call prtiming(6, 'MD')
+ end if
+ if (set%runtyp == p_run_screen) then
+ call prtiming(8, 'screen')
+ end if
+ if (set%runtyp == p_run_modef) then
+ call prtiming(9, 'mode following')
+ end if
+ if (set%runtyp == 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
-
-!$ 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)
+ !> 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)
- 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', '--very-verbose')
+ set%verbose = .true.
+ set%veryverbose = .true.
+
+ case ('--define')
+ call set_define
- case('-v','--verbose')
- set%verbose = .true.
-
- case('-V','--very-verbose')
- set%verbose = .true.
- set%veryverbose = .true.
-
- case( '--define')
- call set_define
-
- case('-P','--parallel')
- !$ if (.false.) then
- call env%warning('Program compiled without threading support', source)
- !$ endif
- ! 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()
- !$ call omp_set_num_threads(idum)
+ case ('-P', '--parallel')
+!$ if (.false.) then
+ call env%warning('Program compiled without threading support', source)
+!$ end if
+ ! 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()
+!$ call omp_set_num_threads(idum)
#ifdef WITH_MKL
- !$ call mkl_set_num_threads(idum)
+!$ call mkl_set_num_threads(idum)
#endif
- !$ endif
- !$ endif
+!$ end if
+!$ end if
- case('--restart')
- restart = .true.
+ case ('--restart')
+ 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 ('-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 ('--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('--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 ('--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('--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
- endif
+ case ('--coffee')
+ coffee = .true.
+
+ case ('-a', '--acc')
+ call args%nextArg(sec)
+ if (allocated(sec)) then
+ if (getValue(env, sec, ddum)) then
+ if (ddum < 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 > 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
+ 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('--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('--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('--gfnff')
- call set_exttyp('ff')
-
- case('--gff')
- call set_exttyp('ff')
-
- case('--mcgfnff')
- call set_exttyp('mcff')
-
- case('--iff')
- call set_exttyp('iff')
-
- case('--tblite')
- if (get_xtb_feature('tblite')) then
- call set_exttyp('tblite')
- else
- call env%error("Compiled without support for tblite library", source)
- return
- endif
-
- 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 ('--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('--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 ('--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('--dipro')
- if (get_xtb_feature('tblite')) then
- dipro%diprocalc = .true.
- call set_runtyp('scc')
+ case ('--gfnff')
+ call set_exttyp('ff')
+
+ case ('--gff')
+ call set_exttyp('ff')
+
+ case ('--mcgfnff')
+ call set_exttyp('mcff')
+
+ case ('--iff')
+ call set_exttyp('iff')
+
+ 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 ('--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
+ 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)
+
+ 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
+
+ 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
+
+ case ('--etemp', '--temp')
call args%nextArg(sec)
if (allocated(sec)) then
- read(sec,'(f10.3)') dipro%othr
+ call set_scc(env, 'temp', sec)
else
- dipro%othr = 0.1_wp
+ call env%error("Temperature in --etemp option is missing", source)
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 ('--esp')
+ call set_runtyp('scc')
+ call set_write(env, 'esp', 'true')
- 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)
+ case ('--stm')
+ call set_runtyp('scc')
+ call set_write(env, 'stm', 'true')
- 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)
-
- case('--cut')
- call set_cut
-
- case('--etemp', '--temp')
- call args%nextArg(sec)
- if (allocated(sec)) then
- call set_scc(env,'temp',sec)
- else
- call env%error("Temperature in --etemp option is missing", source)
- end if
+ case ('--cma')
+ call set_cma
+
+ case ('--tm')
+ call set_exttyp('turbomole')
+
+ case ('--enso')
+ call set_enso_mode
+
+ case ('--json')
+ call set_write(env, 'json', 'true')
+ Call setWRtopo("json", printTopo)
- 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('--cma')
- call set_cma
-
- case('--tm')
- call set_exttyp('turbomole')
-
- case('--enso')
- call set_enso_mode
-
- 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')
-#endif
+ 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)
- if (allocated(sec)) then
- call set_scc(env,'maxiterations',sec)
- else
- call env%error("Integer argument for --iterations is missing", source)
- end if
+ case ('--iterations', '--maxiterations')
+ call args%nextArg(sec)
+ if (allocated(sec)) then
+ call set_scc(env, 'maxiterations', sec)
+ else
+ 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')
- 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')
+ case ('-g', '--gbsa')
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)
+ 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
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')
- call args%nextArg(sec)
- call set_gbsa(env, 'alpb', 'true')
- if (allocated(sec)) then
- call set_gbsa(env, 'solvent', sec)
+ case ('--alpb')
call args%nextArg(sec)
+ call set_gbsa(env, 'alpb', 'true')
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)
+ 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
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')
- call args%nextArg(sec)
- if (allocated(sec)) then
- call set_gbsa(env, 'solvent', sec)
- call set_gbsa(env, flag(3:), 'true')
+ case ('--cosmo', '--tmcosmo')
call args%nextArg(sec)
if (allocated(sec)) then
- if (sec == 'reference') then
- gsolvstate = 1
- else if (sec == 'bar1M') then
- gsolvstate = 2
+ 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
+ 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%warning("Unknown reference state '"//sec//"'", 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
- else
- call env%error("No solvent name provided for COSMO", source)
- end if
-
- case('--cpcmx')
- if (get_xtb_feature('cpcmx')) then
+
+ 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 ('--vomega')
+ call set_gfn(env, 'method', '1')
+ call set_runtyp('vomega')
+
+ case ('--vfukui')
+ call set_runtyp('vfukui')
+
+ case ('--grad')
+ call set_runtyp('grad')
+ lgrad = .true.
+
+ case ('-o', '--opt')
+ call set_runtyp('opt')
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)
+ call set_opt(env, 'optlevel', sec)
end if
- else
- call env%error("The CPCM-X library was not included in this version of xTB.", source)
- end if
+ case ('--hess')
+ call set_runtyp('hess')
- 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('--vomega')
- call set_gfn(env,'method','1')
- call set_runtyp('vomega')
-
- case('--vfukui')
- call set_runtyp('vfukui')
-
- case('--grad')
- call set_runtyp('grad')
- lgrad = .true.
-
- case('-o', '--opt')
- call set_runtyp('opt')
- call args%nextArg(sec)
- if (allocated(sec)) then
- call set_opt(env,'optlevel',sec)
- endif
-
- case('--hess')
- call set_runtyp('hess')
-
- case('--md')
- call set_runtyp('md')
-
- case('--ohess')
- call set_runtyp('ohess')
- call args%nextArg(sec)
- if (allocated(sec)) then
- call set_opt(env,'optlevel',sec)
- endif
-
- case('--bhess')
- call set_runtyp('bhess')
- call args%nextArg(sec)
- if (allocated(sec)) then
- call set_opt(env,'optlevel',sec)
- endif
-
- case('--omd')
- call set_runtyp('omd')
- call set_opt(env,'optlevel','-1')
-
- case('--siman')
- call set_runtyp('siman')
- call set_md(env,'nvt','true')
-
- case('--path')
- call set_runtyp('path')
- call args%nextArg(sec)
- if (allocated(sec)) then
- call set_path(env,'product',sec)
- end if
+ case ('--md')
+ call set_runtyp('md')
- case('--screen')
- call set_runtyp('screen')
+ case ('--ohess')
+ call set_runtyp('ohess')
+ call args%nextArg(sec)
+ if (allocated(sec)) then
+ call set_opt(env, 'optlevel', sec)
+ end if
- case('--gmd')
- call set_runtyp('gmd')
- call env%error("This feature has been deprecated, I'm sorry.", source)
+ case ('--bhess')
+ call set_runtyp('bhess')
+ 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 ('--omd')
+ call set_runtyp('omd')
+ call set_opt(env, 'optlevel', '-1')
- case('--mdopt')
- call set_runtyp('mdopt')
+ case ('--siman')
+ call set_runtyp('siman')
+ call set_md(env, 'nvt', 'true')
- 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 ('--path')
+ call set_runtyp('path')
+ call args%nextArg(sec)
+ if (allocated(sec)) then
+ call set_path(env, 'product', sec)
+ end if
- case('--metaopt')
- call set_runtyp('metaopt')
- call args%nextArg(sec)
- if (allocated(sec)) then
- call set_opt(env,'optlevel',sec)
- end if
+ case ('--screen')
+ call set_runtyp('screen')
- case('--nat')
- call args%nextArg(sec)
- if (allocated(sec)) then
- call set_natom(env,sec)
- end if
+ case ('--gmd')
+ call set_runtyp('gmd')
+ call env%error("This feature has been deprecated, I'm sorry.", source)
- 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 ('--modef')
+ call set_runtyp('modef')
+ call args%nextArg(sec)
+ if (allocated(sec)) then
+ call set_modef(env, 'mode', sec)
+ end if
- 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)
- endif
- end select
- call args%nextFlag(flag)
- end do
+ case ('--mdopt')
+ call set_runtyp('mdopt')
-end subroutine parseArguments
+ 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 ('--metaopt')
+ call set_runtyp('metaopt')
+ call args%nextArg(sec)
+ if (allocated(sec)) then
+ call set_opt(env, 'optlevel', sec)
+ end if
+
+ case ('--nat')
+ call args%nextArg(sec)
+ if (allocated(sec)) then
+ call set_natom(env, sec)
+ end if
+
+ 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 ('--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
+
+ end subroutine parseArguments
!> kronecker delta
-function kron(i,j) result(res_kronij)
- integer, intent(in) :: i,j
- real(wp) :: res_kronij
-
- res_kronij = 0.0_wp
- if(i.eq.j) res_kronij=1.0_wp
-
-end function kron
-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
+ function kron(i, j) result(res_kronij)
+ integer, intent(in) :: i, j
+ real(wp) :: res_kronij
+
+ res_kronij = 0.0_wp
+ if (i == j) res_kronij = 1.0_wp
+
+ end function kron
+ 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
- endif
- old_pos=curr_pos
- enddo
-
-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
+ 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 /= 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
end module xtb_prog_main
diff --git a/src/type/param.f90 b/src/type/param.f90
index 9d5720fda..c6d1b3208 100644
--- a/src/type/param.f90
+++ b/src/type/param.f90
@@ -16,12 +16,12 @@
! along with xtb. If not, see .
module xtb_type_param
- use xtb_mctc_accuracy, only : wp
+ use xtb_mctc_accuracy, only: wp
implicit none
public :: dftd_parameter
public :: TxTBParameter
- public :: scc_parameter
+ public :: scc_parameter
public :: chrg_parameter
private
@@ -71,13 +71,13 @@ module xtb_type_param
end type TxTBParameter
type :: dftd_parameter
- real(wp) :: s6 = -1.0_wp
- real(wp) :: s8 = -1.0_wp
- real(wp) :: s10 = 0.0_wp
- real(wp) :: a1 = -1.0_wp
- real(wp) :: a2 = -1.0_wp
- real(wp) :: s9 = 1.0_wp
- integer :: alp = 16
+ real(wp) :: s6 = -1.0_wp
+ real(wp) :: s8 = -1.0_wp
+ real(wp) :: s10 = 0.0_wp
+ real(wp) :: a1 = -1.0_wp
+ real(wp) :: a2 = -1.0_wp
+ real(wp) :: s9 = 1.0_wp
+ integer :: alp = 16
! for MBD@rsSCS
real(wp) :: beta = 1.0_wp
end type dftd_parameter
@@ -92,13 +92,13 @@ module xtb_type_param
end type scc_parameter
type chrg_parameter
- integer :: n
- real(wp),allocatable :: en(:)
- real(wp),allocatable :: gam(:)
- real(wp),allocatable :: kappa(:)
- real(wp),allocatable :: alpha(:)
- real(wp),allocatable :: dpol(:)
- real(wp),allocatable :: beta(:)
+ integer :: n
+ real(wp), allocatable :: en(:)
+ real(wp), allocatable :: gam(:)
+ real(wp), allocatable :: kappa(:)
+ real(wp), allocatable :: alpha(:)
+ real(wp), allocatable :: dpol(:)
+ real(wp), allocatable :: beta(:)
contains
procedure :: allocate => allocate_chrgeq
procedure :: deallocate => deallocate_chrgeq
@@ -106,37 +106,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.
- endif
- 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 )
- endif
-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/test/unit/molstock.f90 b/test/unit/molstock.f90
index f87548fa1..188a9d6e9 100644
--- a/test/unit/molstock.f90
+++ b/test/unit/molstock.f90
@@ -17,1272 +17,1249 @@
!> A set of molecules for testing
module xtb_test_molstock
- use xtb_mctc_accuracy, only : wp
- use xtb_type_molecule, only : TMolecule, init
+ use xtb_mctc_accuracy, only: wp
+ use xtb_type_molecule, only: TMolecule, init
implicit none
private
public :: getMolecule
-
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('x06_b'); call x06_benzene(mol)
- case('mcv15'); call mcv15(mol)
- end select
-
-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 mindless02(mol)
- type(TMolecule), intent(out) :: mol
- integer, parameter :: nat = 16
- character(len=*), parameter :: sym(nat) = [character(len=4) ::&
- & "H", "S", "B", "O", "Mg", "H", "H", "H", "Si", "H", "B", "Li", "F", "H", "H", "S"]
- real(wp), parameter :: xyz(3, nat) = reshape([&
- & -1.79537625851198_wp, -3.77866422935275_wp, -1.07883558363403_wp, &
- & -2.68278833302782_wp, 0.38892666265890_wp, 1.66214865238427_wp, &
- & 0.11484649791305_wp, 1.48857933226955_wp, 3.65660396510375_wp, &
- & -1.07998879593946_wp, -0.16259121615748_wp, -4.55703065871422_wp, &
- & 0.60302832999383_wp, 4.08816149622342_wp, -0.02589373148029_wp, &
- & -1.22534089315880_wp, -1.79981382478068_wp, -3.70773173318592_wp, &
- & -1.33460982049866_wp, -4.24819082475503_wp, 2.72791902701083_wp, &
- & -0.16278082578516_wp, 2.41267994179303_wp, 5.69030695190570_wp, &
- & 2.87802444057103_wp, -0.33120525058830_wp, 1.88311373530297_wp, &
- & 0.68489327931487_wp, 0.32790204044961_wp, -4.20547693710673_wp, &
- & -1.20919773588330_wp, -2.87253762561437_wp, 0.94064204223101_wp, &
- & -3.25572604597922_wp, 2.21241092990940_wp, -2.86715549314771_wp, &
- & -1.83147468262373_wp, 5.20527293771933_wp, -2.26976270603341_wp, &
- & 4.90885865772880_wp, -1.92576561961811_wp, 2.99069919443735_wp, &
- & 1.26806242248758_wp, -2.60409341782411_wp, 0.55162805282247_wp, &
- & 4.11956976339902_wp, 1.59892866766766_wp, -1.39117477789609_wp],&
- & shape(xyz))
- integer, parameter :: uhf = 1
- call init(mol, sym, xyz, uhf=uhf)
-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 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 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 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 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
+ 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 ('x06_b'); call x06_benzene(mol)
+ case ('mcv15'); call mcv15(mol)
+ end select
+ end subroutine getMolecule
-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 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
+ integer, parameter :: nat = 16
+ character(len=*), parameter :: sym(nat) = [character(len=4) ::&
+ & "H", "S", "B", "O", "Mg", "H", "H", "H", "Si", "H", "B", "Li", "F", "H", "H", "S"]
+ real(wp), parameter :: xyz(3, nat) = reshape([&
+ & -1.79537625851198_wp, -3.77866422935275_wp, -1.07883558363403_wp, &
+ & -2.68278833302782_wp, 0.38892666265890_wp, 1.66214865238427_wp, &
+ & 0.11484649791305_wp, 1.48857933226955_wp, 3.65660396510375_wp, &
+ & -1.07998879593946_wp, -0.16259121615748_wp, -4.55703065871422_wp, &
+ & 0.60302832999383_wp, 4.08816149622342_wp, -0.02589373148029_wp, &
+ & -1.22534089315880_wp, -1.79981382478068_wp, -3.70773173318592_wp, &
+ & -1.33460982049866_wp, -4.24819082475503_wp, 2.72791902701083_wp, &
+ & -0.16278082578516_wp, 2.41267994179303_wp, 5.69030695190570_wp, &
+ & 2.87802444057103_wp, -0.33120525058830_wp, 1.88311373530297_wp, &
+ & 0.68489327931487_wp, 0.32790204044961_wp, -4.20547693710673_wp, &
+ & -1.20919773588330_wp, -2.87253762561437_wp, 0.94064204223101_wp, &
+ & -3.25572604597922_wp, 2.21241092990940_wp, -2.86715549314771_wp, &
+ & -1.83147468262373_wp, 5.20527293771933_wp, -2.26976270603341_wp, &
+ & 4.90885865772880_wp, -1.92576561961811_wp, 2.99069919443735_wp, &
+ & 1.26806242248758_wp, -2.60409341782411_wp, 0.55162805282247_wp, &
+ & 4.11956976339902_wp, 1.59892866766766_wp, -1.39117477789609_wp],&
+ & shape(xyz))
+ integer, parameter :: uhf = 1
+ call init(mol, sym, xyz, uhf=uhf)
+ end subroutine mindless02
-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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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
- call init(mol, sym, xyz, chrg=charge)
- mol%ftype = fileType%sdf
+ 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
- allocate(mol%sdf(nat), source=sdf_data())
- mol%sdf(charge_at)%charge = nint(charge)
+ call init(mol, sym, xyz, chrg=charge)
+ mol%ftype = fileType%sdf
- 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
+ allocate (mol%sdf(nat), source=sdf_data())
+ mol%sdf(charge_at)%charge = nint(charge)
-end subroutine bug332
+ 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
-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
+ end subroutine bug332
-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 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 x06_benzene(mol)
- type(TMolecule), intent(out) :: mol
- integer, parameter :: nat = 48
- character(len=*), parameter :: sym(nat) = [character(len=4) ::&
- & "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", &
- & "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", &
- & "C", "C", "C", "C", "H", "H", "H", "H", "H", "H", &
- & "H", "H", "H", "H", "H", "H", "H", "H", "H", "H", &
- & "H", "H", "H", "H", "H", "H", "H", "H"]
- real(wp), parameter :: xyz(3, nat) = reshape([&
- & 7.10986726811546E+00_wp, 1.39803317039751E+01_wp, 9.79695027924021E+00_wp, &
- & 7.11375821259805E+00_wp, 8.76795203096078E+00_wp, 3.36407395831929E+00_wp, &
- & 8.60482372324771E+00_wp, 5.13823133707231E+00_wp, 1.25907033747429E+01_wp, &
- & 9.75112376027930E+00_wp, 7.53368379774428E+00_wp, 1.25988946977277E+01_wp, &
- & 5.96704128865761E+00_wp, 6.37267695865231E+00_wp, 3.35549866706958E+00_wp, &
- & 9.00267279659253E+00_wp, 9.34854414468852E+00_wp, 1.58886068020756E+00_wp, &
- & 6.71563121464733E+00_wp, 4.55781661170807E+00_wp, 1.56671851026428E+00_wp, &
- & 2.01592612889045E+00_wp, 1.34582777502016E+01_wp, 1.56454269009644E+00_wp, &
- & 1.36276161633625E+01_wp, 5.11410651963663E-01_wp, 1.59001258500230E+00_wp, &
- & 2.76479397948607E+00_wp, 1.52711868251473E+01_wp, 3.35524268822630E+00_wp, &
- & 1.28790262373728E+01_wp, 1.64375153151443E+01_wp, 1.25977427929330E+01_wp, &
- & 1.62071733930167E+00_wp, 5.14124693925177E+00_wp, 9.79797419461331E+00_wp, &
- & 1.27150507198922E-01_wp, 8.76741986587029E+00_wp, 6.22310165885711E+00_wp, &
- & 2.76687841403031E+00_wp, 7.53687678828724E+00_wp, 9.78696710435249E+00_wp, &
- & 1.28772197274344E+01_wp, 6.37179001683482E+00_wp, 6.23423673853957E+00_wp, &
- & 2.01689886501110E+00_wp, 9.34978586323301E+00_wp, 7.99677906390919E+00_wp, &
- & 1.27706356410721E-01_wp, 1.40413533010183E+01_wp, 1.25881435863102E+01_wp, &
- & 1.61946667857512E+00_wp, 1.76671714509098E+01_wp, 3.36548184195730E+00_wp, &
- & 8.99919873901879E+00_wp, 1.33969013764314E+01_wp, 8.02314488476650E+00_wp, &
- & 5.96523477871927E+00_wp, 1.63766711064646E+01_wp, 9.78632715724430E+00_wp, &
- & 9.74959517494686E+00_wp, 1.52094556746502E+01_wp, 6.23270086547992E+00_wp, &
- & 8.60482372324771E+00_wp, 1.76057950771396E+01_wp, 6.22182176464074E+00_wp, &
- & 6.71535329004143E+00_wp, 4.50389054920479E-01_wp, 7.99562715911445E+00_wp, &
- & 1.36270603141507E+01_wp, 4.55888094188905E+00_wp, 8.02442477898288E+00_wp, &
- & 1.12337125704490E+01_wp, 7.97130089049293E+00_wp, 1.12071377268419E+01_wp, &
- & 5.79806312827085E+00_wp, 2.31828852255051E+00_wp, 7.97514885165245E+00_wp, &
- & 9.14344160948052E+00_wp, 3.72249480799774E+00_wp, 1.11681009532424E+01_wp, &
- & 6.57555721327409E+00_wp, 1.01835111716719E+01_wp, 4.78718833750633E+00_wp, &
- & 4.24696590274695E+00_wp, 1.48321506254907E+01_wp, 4.74712764853380E+00_wp, &
- & 1.27099091146831E+01_wp, 2.37913273123019E+00_wp, 1.60972295593447E+00_wp, &
- & 2.93391110217578E+00_wp, 1.15907330592985E+01_wp, 1.54457634032100E+00_wp, &
- & 1.13967153518090E+01_wp, 1.68763741264374E+01_wp, 1.12061138114688E+01_wp, &
- & 4.48473040309378E+00_wp, 5.93505986590366E+00_wp, 4.74751161679871E+00_wp, &
- & 2.15975211244333E+00_wp, 3.72728429381217E+00_wp, 1.12222404785951E+01_wp, &
- & 5.79667350524135E+00_wp, 2.69080408589553E+00_wp, 1.54803205470521E+00_wp, &
- & 9.92149154369556E+00_wp, 1.12155566705011E+01_wp, 1.60729115692336E+00_wp, &
- & 1.34851798028391E+01_wp, 1.26270358788517E+01_wp, 1.11638773023284E+01_wp, &
- & 1.13944919549618E+01_wp, 5.93293120554168E+00_wp, 4.84311971476190E+00_wp, &
- & 4.25002307341184E+00_wp, 7.97555821121688E+00_wp, 1.11778281492869E+01_wp, &
- & 1.27082415670477E+01_wp, 2.69186841607651E+00_wp, 8.04490308644487E+00_wp, &
- & 2.93557864981118E+00_wp, 1.12169757774090E+01_wp, 7.97591678818228E+00_wp, &
- & 6.56985975885316E+00_wp, 1.25663690585355E+01_wp, 1.12210885738004E+01_wp, &
- & 9.14510915711592E+00_wp, 1.28092137281638E+00_wp, 4.79793944892387E+00_wp, &
- & 1.12321839851166E+01_wp, 1.47700646982665E+01_wp, 4.84171183112389E+00_wp, &
- & 4.48153427012594E+00_wp, 1.68157073061212E+01_wp, 1.11765482550705E+01_wp, &
- & 9.91718371230412E+00_wp, 1.15293566855284E+01_wp, 8.04375118165014E+00_wp, &
- & 1.34839291421126E+01_wp, 1.01815598996734E+01_wp, 4.79909135371861E+00_wp, &
- & 2.15794560250498E+00_wp, 1.34247513495005E+00_wp, 4.79000410478235E+00_wp], shape(xyz))
- real(wp), parameter :: lattice(3,3) = reshape([&
- & 13.8962302949642, 0.00000000000000, 0.00000000000000, &
- & 0.00000000000000, 17.73883634976286, 0.00000000000000, &
- & 0.00000000000000, 0.00000000000000, 12.79894216374709],shape(lattice))
- real(wp), parameter :: charge = 0.0_wp
- integer, parameter :: uhf = 0
- logical, parameter :: pbc(3) = [.true., .true., .true. ]
- call init(mol, sym, xyz, charge, uhf, lattice, pbc)
-end subroutine x06_benzene
+ 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 x06_benzene(mol)
+ type(TMolecule), intent(out) :: mol
+ integer, parameter :: nat = 48
+ character(len=*), parameter :: sym(nat) = [character(len=4) ::&
+ & "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", &
+ & "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", &
+ & "C", "C", "C", "C", "H", "H", "H", "H", "H", "H", &
+ & "H", "H", "H", "H", "H", "H", "H", "H", "H", "H", &
+ & "H", "H", "H", "H", "H", "H", "H", "H"]
+ real(wp), parameter :: xyz(3, nat) = reshape([&
+ & 7.10986726811546E+00_wp, 1.39803317039751E+01_wp, 9.79695027924021E+00_wp, &
+ & 7.11375821259805E+00_wp, 8.76795203096078E+00_wp, 3.36407395831929E+00_wp, &
+ & 8.60482372324771E+00_wp, 5.13823133707231E+00_wp, 1.25907033747429E+01_wp, &
+ & 9.75112376027930E+00_wp, 7.53368379774428E+00_wp, 1.25988946977277E+01_wp, &
+ & 5.96704128865761E+00_wp, 6.37267695865231E+00_wp, 3.35549866706958E+00_wp, &
+ & 9.00267279659253E+00_wp, 9.34854414468852E+00_wp, 1.58886068020756E+00_wp, &
+ & 6.71563121464733E+00_wp, 4.55781661170807E+00_wp, 1.56671851026428E+00_wp, &
+ & 2.01592612889045E+00_wp, 1.34582777502016E+01_wp, 1.56454269009644E+00_wp, &
+ & 1.36276161633625E+01_wp, 5.11410651963663E-01_wp, 1.59001258500230E+00_wp, &
+ & 2.76479397948607E+00_wp, 1.52711868251473E+01_wp, 3.35524268822630E+00_wp, &
+ & 1.28790262373728E+01_wp, 1.64375153151443E+01_wp, 1.25977427929330E+01_wp, &
+ & 1.62071733930167E+00_wp, 5.14124693925177E+00_wp, 9.79797419461331E+00_wp, &
+ & 1.27150507198922E-01_wp, 8.76741986587029E+00_wp, 6.22310165885711E+00_wp, &
+ & 2.76687841403031E+00_wp, 7.53687678828724E+00_wp, 9.78696710435249E+00_wp, &
+ & 1.28772197274344E+01_wp, 6.37179001683482E+00_wp, 6.23423673853957E+00_wp, &
+ & 2.01689886501110E+00_wp, 9.34978586323301E+00_wp, 7.99677906390919E+00_wp, &
+ & 1.27706356410721E-01_wp, 1.40413533010183E+01_wp, 1.25881435863102E+01_wp, &
+ & 1.61946667857512E+00_wp, 1.76671714509098E+01_wp, 3.36548184195730E+00_wp, &
+ & 8.99919873901879E+00_wp, 1.33969013764314E+01_wp, 8.02314488476650E+00_wp, &
+ & 5.96523477871927E+00_wp, 1.63766711064646E+01_wp, 9.78632715724430E+00_wp, &
+ & 9.74959517494686E+00_wp, 1.52094556746502E+01_wp, 6.23270086547992E+00_wp, &
+ & 8.60482372324771E+00_wp, 1.76057950771396E+01_wp, 6.22182176464074E+00_wp, &
+ & 6.71535329004143E+00_wp, 4.50389054920479E-01_wp, 7.99562715911445E+00_wp, &
+ & 1.36270603141507E+01_wp, 4.55888094188905E+00_wp, 8.02442477898288E+00_wp, &
+ & 1.12337125704490E+01_wp, 7.97130089049293E+00_wp, 1.12071377268419E+01_wp, &
+ & 5.79806312827085E+00_wp, 2.31828852255051E+00_wp, 7.97514885165245E+00_wp, &
+ & 9.14344160948052E+00_wp, 3.72249480799774E+00_wp, 1.11681009532424E+01_wp, &
+ & 6.57555721327409E+00_wp, 1.01835111716719E+01_wp, 4.78718833750633E+00_wp, &
+ & 4.24696590274695E+00_wp, 1.48321506254907E+01_wp, 4.74712764853380E+00_wp, &
+ & 1.27099091146831E+01_wp, 2.37913273123019E+00_wp, 1.60972295593447E+00_wp, &
+ & 2.93391110217578E+00_wp, 1.15907330592985E+01_wp, 1.54457634032100E+00_wp, &
+ & 1.13967153518090E+01_wp, 1.68763741264374E+01_wp, 1.12061138114688E+01_wp, &
+ & 4.48473040309378E+00_wp, 5.93505986590366E+00_wp, 4.74751161679871E+00_wp, &
+ & 2.15975211244333E+00_wp, 3.72728429381217E+00_wp, 1.12222404785951E+01_wp, &
+ & 5.79667350524135E+00_wp, 2.69080408589553E+00_wp, 1.54803205470521E+00_wp, &
+ & 9.92149154369556E+00_wp, 1.12155566705011E+01_wp, 1.60729115692336E+00_wp, &
+ & 1.34851798028391E+01_wp, 1.26270358788517E+01_wp, 1.11638773023284E+01_wp, &
+ & 1.13944919549618E+01_wp, 5.93293120554168E+00_wp, 4.84311971476190E+00_wp, &
+ & 4.25002307341184E+00_wp, 7.97555821121688E+00_wp, 1.11778281492869E+01_wp, &
+ & 1.27082415670477E+01_wp, 2.69186841607651E+00_wp, 8.04490308644487E+00_wp, &
+ & 2.93557864981118E+00_wp, 1.12169757774090E+01_wp, 7.97591678818228E+00_wp, &
+ & 6.56985975885316E+00_wp, 1.25663690585355E+01_wp, 1.12210885738004E+01_wp, &
+ & 9.14510915711592E+00_wp, 1.28092137281638E+00_wp, 4.79793944892387E+00_wp, &
+ & 1.12321839851166E+01_wp, 1.47700646982665E+01_wp, 4.84171183112389E+00_wp, &
+ & 4.48153427012594E+00_wp, 1.68157073061212E+01_wp, 1.11765482550705E+01_wp, &
+ & 9.91718371230412E+00_wp, 1.15293566855284E+01_wp, 8.04375118165014E+00_wp, &
+ & 1.34839291421126E+01_wp, 1.01815598996734E+01_wp, 4.79909135371861E+00_wp, &
+ & 2.15794560250498E+00_wp, 1.34247513495005E+00_wp, 4.79000410478235E+00_wp], shape(xyz))
+ real(wp), parameter :: lattice(3, 3) = reshape([&
+ & 13.8962302949642, 0.00000000000000, 0.00000000000000, &
+ & 0.00000000000000, 17.73883634976286, 0.00000000000000, &
+ & 0.00000000000000, 0.00000000000000, 12.79894216374709], shape(lattice))
+ real(wp), parameter :: charge = 0.0_wp
+ integer, parameter :: uhf = 0
+ logical, parameter :: pbc(3) = [.true., .true., .true.]
+ call init(mol, sym, xyz, charge, uhf, lattice, pbc)
+ end subroutine x06_benzene
-subroutine mcv15(mol)
- type(TMolecule), intent(out) :: mol
- integer, parameter :: nat = 64
- character(len=*), parameter :: sym(nat) = [character(len=4) :: &
- & "S", "S", "P", "P", "O", "O", "O", "O", "N", "N", "N", "N", &
- & "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", &
- & "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", "H", "H", &
- & "H", "H", "H", "H", "H", "H", "H", "H", "H", "H", "H", "H", &
- & "H", "H", "H", "H", "H", "H", "H", "H", "H", "H", "Cl", "Cl", &
- & "Cl", "Cl", "Cl", "Cl"]
- real(wp), parameter :: xyz(3, nat) = reshape([&
- & -0.704784105_wp, 1.8541209222_wp, 10.504707540_wp, &
- & 6.2799557383_wp, 6.2379452489_wp, 14.645344247_wp, &
- & 2.4354591602_wp, 11.092016366_wp, 9.0113485664_wp, &
- & 3.1397124725_wp, -2.999950195_wp, 16.138703221_wp, &
- & 4.4877885855_wp, 9.5312072789_wp, 10.174901564_wp, &
- & 1.0873830473_wp, -1.439141107_wp, 14.975150223_wp, &
- & -0.263379632_wp, 10.231208650_wp, 9.2521909253_wp, &
- & 5.8385512657_wp, -2.139142479_wp, 15.897860862_wp, &
- & 10.389327160_wp, -0.485994960_wp, 13.796934762_wp, &
- & -4.814155527_wp, 8.5780611312_wp, 11.353117025_wp, &
- & 8.7184295500_wp, 1.2296995930_wp, 10.014851170_wp, &
- & -3.143257917_wp, 6.8623665781_wp, 15.135200617_wp, &
- & 10.624000637_wp, 0.7016647959_wp, 11.630437889_wp, &
- & -5.048829005_wp, 7.3904013751_wp, 13.519613898_wp, &
- & -2.200587757_wp, 3.0764030007_wp, 7.8709638189_wp, &
- & 7.7757593898_wp, 5.0156631703_wp, 17.279087969_wp, &
- & 9.4811992345_wp, 2.5840131592_wp, 7.8605577886_wp, &
- & -3.906027601_wp, 5.5080530118_wp, 17.289493999_wp, &
- & 6.2207909803_wp, 0.0940870720_wp, 10.316875494_wp, &
- & -0.645619347_wp, 7.9979790991_wp, 14.833176293_wp, &
- & 7.6830144600_wp, 3.3804459587_wp, 5.9130125325_wp, &
- & -2.107842827_wp, 4.7116202124_wp, 19.237039255_wp, &
- & 5.5456882676_wp, 4.7937900149_wp, 6.5447240519_wp, &
- & 0.0294833652_wp, 3.2982761562_wp, 18.605327736_wp, &
- & 3.9093376146_wp, 5.6042597538_wp, 4.6698738502_wp, &
- & 1.6658340182_wp, 2.4878064173_wp, 20.480177937_wp, &
- & 4.3745843289_wp, 5.0132458319_wp, 2.1545473298_wp, &
- & 1.2005873038_wp, 3.0788203392_wp, 22.995504458_wp, &
- & 6.5193536846_wp, 3.6412446371_wp, 1.5131056695_wp, &
- & -0.944182051_wp, 4.4508215339_wp, 23.636946118_wp, &
- & 8.1726580439_wp, 2.8302489082_wp, 3.3779894677_wp, &
- & -2.597486411_wp, 5.2618172628_wp, 21.772062320_wp, &
- & -3.017508989_wp, 11.070724086_wp, 4.4375332419_wp, &
- & 8.5926806220_wp, -2.978657915_wp, 20.712518546_wp, &
- & -1.163194341_wp, 4.1330712708_wp, 6.4779746057_wp, &
- & 6.7383659747_wp, 3.9589949002_wp, 18.672077182_wp, &
- & 4.8672586925_wp, 1.2052465936_wp, 9.2468732542_wp, &
- & 0.7079129402_wp, 6.8868195775_wp, 15.903178533_wp, &
- & 5.6559681045_wp, 0.1201590543_wp, 12.298638968_wp, &
- & -0.080796471_wp, 7.9719071168_wp, 12.851412819_wp, &
- & 5.2054463494_wp, 5.3606192448_wp, 8.4822270795_wp, &
- & 0.3697252834_wp, 2.7314469262_wp, 16.667824708_wp, &
- & 2.2798534357_wp, 6.7368342734_wp, 5.1716119842_wp, &
- & 3.2953181971_wp, 1.3552318977_wp, 19.978439803_wp, &
- & 3.0839809259_wp, 5.6380927002_wp, 0.6944985262_wp, &
- & 2.4911907069_wp, 2.4539734708_wp, 24.455553261_wp, &
- & 1.9478108468_wp, -2.981417863_wp, 24.839373077_wp, &
- & 3.6273607860_wp, 11.073484034_wp, 0.3106787105_wp, &
- & 9.8399363161_wp, 1.7503364609_wp, 2.8851221671_wp, &
- & -4.264764683_wp, 6.3417297101_wp, 22.264929621_wp, &
- & 2.9626243744_wp, 11.460780681_wp, 6.4062306843_wp, &
- & 2.6125472584_wp, -3.368714510_wp, 18.743821103_wp, &
- & 8.6911615512_wp, -1.230382938_wp, 14.368502229_wp, &
- & -3.115989918_wp, 9.3224491097_wp, 10.781549558_wp, &
- & -2.127273673_wp, -1.000369135_wp, 14.678356340_wp, &
- & 7.7024453060_wp, 9.0924353068_wp, 10.471695447_wp, &
- & -2.177136732_wp, 10.793914095_wp, 6.2993188375_wp, &
- & 7.7523083650_wp, -2.701847924_wp, 18.850732950_wp, &
- & 1.7261160374_wp, -0.286764238_wp, 3.3630876937_wp, &
- & 3.8490555954_wp, 8.3788304098_wp, 21.786964094_wp, &
- & -1.998776063_wp, 8.5349880314_wp, 2.4962465787_wp, &
- & 7.5739476960_wp, -0.442921860_wp, 22.653805209_wp, &
- & 7.8365465637_wp, 11.032255979_wp, 4.7537064890_wp, &
- & -2.261374930_wp, -2.940189808_wp, 20.396345299_wp] , shape(xyz))
- real(wp), parameter :: lattice(3,3) = reshape([&
- & 14.17654659798719_wp, -0.00424862639192_wp, -0.00394399802297_wp, &
- & -3.64444068770540_wp, 14.26901592236016_wp, -0.13224999070830_wp, &
- & -4.95693427750094_wp, -6.17270112491500_wp, 25.28624577677911_wp], shape(lattice))
- real(wp), parameter :: charge = 0.0_wp
- integer, parameter :: uhf = 0
- logical, parameter :: pbc(3) = [.true., .true., .true. ]
- call init(mol, sym, xyz, charge, uhf, lattice, pbc)
-end subroutine mcv15
+ subroutine mcv15(mol)
+ type(TMolecule), intent(out) :: mol
+ integer, parameter :: nat = 64
+ character(len=*), parameter :: sym(nat) = [character(len=4) :: &
+ & "S", "S", "P", "P", "O", "O", "O", "O", "N", "N", "N", "N", &
+ & "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", &
+ & "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", "H", "H", &
+ & "H", "H", "H", "H", "H", "H", "H", "H", "H", "H", "H", "H", &
+ & "H", "H", "H", "H", "H", "H", "H", "H", "H", "H", "Cl", "Cl", &
+ & "Cl", "Cl", "Cl", "Cl"]
+ real(wp), parameter :: xyz(3, nat) = reshape([&
+ & -0.704784105_wp, 1.8541209222_wp, 10.504707540_wp, &
+ & 6.2799557383_wp, 6.2379452489_wp, 14.645344247_wp, &
+ & 2.4354591602_wp, 11.092016366_wp, 9.0113485664_wp, &
+ & 3.1397124725_wp, -2.999950195_wp, 16.138703221_wp, &
+ & 4.4877885855_wp, 9.5312072789_wp, 10.174901564_wp, &
+ & 1.0873830473_wp, -1.439141107_wp, 14.975150223_wp, &
+ & -0.263379632_wp, 10.231208650_wp, 9.2521909253_wp, &
+ & 5.8385512657_wp, -2.139142479_wp, 15.897860862_wp, &
+ & 10.389327160_wp, -0.485994960_wp, 13.796934762_wp, &
+ & -4.814155527_wp, 8.5780611312_wp, 11.353117025_wp, &
+ & 8.7184295500_wp, 1.2296995930_wp, 10.014851170_wp, &
+ & -3.143257917_wp, 6.8623665781_wp, 15.135200617_wp, &
+ & 10.624000637_wp, 0.7016647959_wp, 11.630437889_wp, &
+ & -5.048829005_wp, 7.3904013751_wp, 13.519613898_wp, &
+ & -2.200587757_wp, 3.0764030007_wp, 7.8709638189_wp, &
+ & 7.7757593898_wp, 5.0156631703_wp, 17.279087969_wp, &
+ & 9.4811992345_wp, 2.5840131592_wp, 7.8605577886_wp, &
+ & -3.906027601_wp, 5.5080530118_wp, 17.289493999_wp, &
+ & 6.2207909803_wp, 0.0940870720_wp, 10.316875494_wp, &
+ & -0.645619347_wp, 7.9979790991_wp, 14.833176293_wp, &
+ & 7.6830144600_wp, 3.3804459587_wp, 5.9130125325_wp, &
+ & -2.107842827_wp, 4.7116202124_wp, 19.237039255_wp, &
+ & 5.5456882676_wp, 4.7937900149_wp, 6.5447240519_wp, &
+ & 0.0294833652_wp, 3.2982761562_wp, 18.605327736_wp, &
+ & 3.9093376146_wp, 5.6042597538_wp, 4.6698738502_wp, &
+ & 1.6658340182_wp, 2.4878064173_wp, 20.480177937_wp, &
+ & 4.3745843289_wp, 5.0132458319_wp, 2.1545473298_wp, &
+ & 1.2005873038_wp, 3.0788203392_wp, 22.995504458_wp, &
+ & 6.5193536846_wp, 3.6412446371_wp, 1.5131056695_wp, &
+ & -0.944182051_wp, 4.4508215339_wp, 23.636946118_wp, &
+ & 8.1726580439_wp, 2.8302489082_wp, 3.3779894677_wp, &
+ & -2.597486411_wp, 5.2618172628_wp, 21.772062320_wp, &
+ & -3.017508989_wp, 11.070724086_wp, 4.4375332419_wp, &
+ & 8.5926806220_wp, -2.978657915_wp, 20.712518546_wp, &
+ & -1.163194341_wp, 4.1330712708_wp, 6.4779746057_wp, &
+ & 6.7383659747_wp, 3.9589949002_wp, 18.672077182_wp, &
+ & 4.8672586925_wp, 1.2052465936_wp, 9.2468732542_wp, &
+ & 0.7079129402_wp, 6.8868195775_wp, 15.903178533_wp, &
+ & 5.6559681045_wp, 0.1201590543_wp, 12.298638968_wp, &
+ & -0.080796471_wp, 7.9719071168_wp, 12.851412819_wp, &
+ & 5.2054463494_wp, 5.3606192448_wp, 8.4822270795_wp, &
+ & 0.3697252834_wp, 2.7314469262_wp, 16.667824708_wp, &
+ & 2.2798534357_wp, 6.7368342734_wp, 5.1716119842_wp, &
+ & 3.2953181971_wp, 1.3552318977_wp, 19.978439803_wp, &
+ & 3.0839809259_wp, 5.6380927002_wp, 0.6944985262_wp, &
+ & 2.4911907069_wp, 2.4539734708_wp, 24.455553261_wp, &
+ & 1.9478108468_wp, -2.981417863_wp, 24.839373077_wp, &
+ & 3.6273607860_wp, 11.073484034_wp, 0.3106787105_wp, &
+ & 9.8399363161_wp, 1.7503364609_wp, 2.8851221671_wp, &
+ & -4.264764683_wp, 6.3417297101_wp, 22.264929621_wp, &
+ & 2.9626243744_wp, 11.460780681_wp, 6.4062306843_wp, &
+ & 2.6125472584_wp, -3.368714510_wp, 18.743821103_wp, &
+ & 8.6911615512_wp, -1.230382938_wp, 14.368502229_wp, &
+ & -3.115989918_wp, 9.3224491097_wp, 10.781549558_wp, &
+ & -2.127273673_wp, -1.000369135_wp, 14.678356340_wp, &
+ & 7.7024453060_wp, 9.0924353068_wp, 10.471695447_wp, &
+ & -2.177136732_wp, 10.793914095_wp, 6.2993188375_wp, &
+ & 7.7523083650_wp, -2.701847924_wp, 18.850732950_wp, &
+ & 1.7261160374_wp, -0.286764238_wp, 3.3630876937_wp, &
+ & 3.8490555954_wp, 8.3788304098_wp, 21.786964094_wp, &
+ & -1.998776063_wp, 8.5349880314_wp, 2.4962465787_wp, &
+ & 7.5739476960_wp, -0.442921860_wp, 22.653805209_wp, &
+ & 7.8365465637_wp, 11.032255979_wp, 4.7537064890_wp, &
+ & -2.261374930_wp, -2.940189808_wp, 20.396345299_wp], shape(xyz))
+ real(wp), parameter :: lattice(3, 3) = reshape([&
+ & 14.17654659798719_wp, -0.00424862639192_wp, -0.00394399802297_wp, &
+ & -3.64444068770540_wp, 14.26901592236016_wp, -0.13224999070830_wp, &
+ & -4.95693427750094_wp, -6.17270112491500_wp, 25.28624577677911_wp], shape(lattice))
+ real(wp), parameter :: charge = 0.0_wp
+ integer, parameter :: uhf = 0
+ logical, parameter :: pbc(3) = [.true., .true., .true.]
+ call init(mol, sym, xyz, charge, uhf, lattice, pbc)
+ end subroutine mcv15
end module xtb_test_molstock