@@ -32,6 +32,8 @@ module tblite_api
3232 use tblite_wavefunction_type,only:wavefunction_type,new_wavefunction
3333 use tblite_wavefunction,only:sad_guess,eeq_guess
3434 use tblite_xtb,xtb_calculator = > xtb_calculator
35+ use tblite_xtb_calculator, only: new_xtb_calculator
36+ use tblite_param, only : param_record
3537 use tblite_results,only:tblite_resultstype = > results_type
3638 use tblite_wavefunction_mulliken,only:get_molecular_dipole_moment
3739 use tblite_ceh_singlepoint,only:ceh_guess
@@ -65,6 +67,7 @@ module tblite_api
6567 type :: tblite_data
6668 integer :: lvl = 0
6769 real (wp) :: accuracy = 1.0_wp
70+ character (len= :),allocatable :: paramfile
6871 type (wavefunction_type) :: wfn
6972 type (xtb_calculator) :: calc
7073 type (tblite_ctx) :: ctx
@@ -81,17 +84,13 @@ module tblite_api
8184 ! > the guesses can be used for charges, but NOT for e+grd!
8285 integer :: eeq = 4
8386 integer :: ceh = 5
87+ integer :: param = 6
8488 end type enum_tblite_method
8589 type (enum_tblite_method),parameter ,public :: xtblvl = enum_tblite_method()
8690
8791 ! > Conversion factor from Kelvin to Hartree
8892 real (wp),parameter :: ktoau = 3.166808578545117e-06_wp
8993
90- integer :: verbosity = 0
91- ! > IMPORTANT: tblite is not entirely thread-safe
92- ! > if verbosity is >0. We'll have to turn it off.
93- ! > At least for statically compiled binaries
94-
9594 public :: wavefunction_type,xtb_calculator
9695 public :: tblite_ctx,tblite_resultstype
9796 public :: tblite_setup,tblite_singlepoint,tblite_addsettings
@@ -121,10 +120,12 @@ subroutine tblite_setup(mol,chrg,uhf,lvl,etemp,tblite)
121120#ifdef WITH_TBLITE
122121 type (structure_type) :: mctcmol
123122 type (error_type),allocatable :: error
123+ type (param_record) :: param
124124
125125 real (wp) :: etemp_au,energy
126126 real (wp),allocatable :: grad(:,:)
127127 logical :: pr
128+ integer :: io
128129
129130 pr = (tblite% ctx% verbosity > 0 )
130131
@@ -149,6 +150,19 @@ subroutine tblite_setup(mol,chrg,uhf,lvl,etemp,tblite)
149150 case (xtblvl% eeq)
150151 if (pr) call tblite% ctx% message(" tblite> setting up D4 EEQ charges calculation" )
151152 call new_ceh_calculator(tblite% calc,mctcmol) ! > doesn't matter but needs initialization
153+ case (xtblvl% param)
154+ if (pr) call tblite% ctx% message(" tblite> setting up xtb calculator from parameter file" )
155+ if (allocated (tblite% paramfile))then
156+ call tblite_read_param_record(tblite% paramfile,param,io)
157+ call new_xtb_calculator(tblite% calc, mctcmol, param, error)
158+ if (allocated (error))then
159+ write (stdout,* ) ' Could not read tblite parameter file ' // tblite% paramfile
160+ error stop
161+ endif
162+ else
163+ if (pr) call tblite% ctx% message(" tblite> parameter file does not exist, defaulting to GFN2-xTB" )
164+ call new_gfn2_calculator(tblite% calc,mctcmol)
165+ endif
152166 case default
153167 call tblite% ctx% message(" Error: Unknown method in tblite!" )
154168 error stop
@@ -202,7 +216,7 @@ subroutine tblite_add_solv(mol,chrg,uhf,tblite,smodel,solvent)
202216 pr = (tblite% ctx% verbosity > 0 )
203217
204218! >--- some tblite calculators have nothing to do with implicit solvation
205- if (tblite% lvl > 3 ) then
219+ if (tblite% lvl > 3 .and. tblite % lvl .ne. xtblvl % param ) then
206220 if (pr) call tblite% ctx% message(" tblite> skipping implicit solvation setup for this potential" )
207221 return
208222 end if
@@ -282,11 +296,17 @@ subroutine tblite_singlepoint(mol,chrg,uhf,tblite,energy,gradient,iostatus)
282296 type (error_type),allocatable :: error
283297 real (wp) :: sigma(3 ,3 )
284298 logical :: pr
299+ integer :: verbosity
285300
286301 iostatus = 0
287302 energy = 0.0_wp
288303 gradient(:,:) = 0.0_wp
289304 pr = (tblite% ctx% verbosity > 0 )
305+ if (tblite% ctx% verbosity> 1 )then
306+ verbosity = tblite% ctx% verbosity
307+ else
308+ verbosity = 0
309+ endif
290310
291311! >--- make an mctcmol object from mol
292312 call tblite_mol2mol(mol,chrg,uhf,mctcmol)
@@ -454,6 +474,42 @@ subroutine tblite_getdipole(mol,chrg,uhf,tblite,dipole)
454474#endif
455475 end subroutine tblite_getdipole
456476
477+ ! ========================================================================================!
478+
479+ #ifdef WITH_TBLITE
480+ subroutine tblite_read_param_record (paramfile ,param ,io )
481+ use tomlf
482+ implicit none
483+ character (len=* ),intent (in ) :: paramfile
484+ type (param_record),intent (out ) :: param
485+ integer ,intent (out ) :: io
486+ type (error_type),allocatable :: error
487+ type (toml_table),allocatable :: table
488+ type (toml_error),allocatable :: terror
489+ type (toml_context) :: tcontext
490+ logical ,parameter :: color = .true.
491+
492+ io= 1
493+
494+ call toml_load(table,paramfile,error= terror,context= tcontext, &
495+ & config= toml_parser_config(color= color))
496+ if (allocated (terror))then
497+ io= 1
498+ return
499+ endif
500+
501+ call param% load_from_toml(table,error)
502+
503+ if (allocated (error))then
504+ io= 1
505+ else
506+ io= 0
507+ endif
508+ if (allocated (table))deallocate (table)
509+
510+ end subroutine tblite_read_param_record
511+ #endif
512+
457513! ========================================================================================!
458514! ========================================================================================!
459515end module tblite_api
0 commit comments