1414! limitations under the License.
1515
1616program main
17- use , intrinsic :: iso_fortran_env, only : output_unit, error_unit, input_unit
18- use mctc_env, only : error_type, fatal_error, get_argument, wp
19- use mctc_io, only : structure_type, read_structure, filetype, get_filetype
20- use multicharge, only : mchrg_model_type, new_eeq2019_model, &
21- & write_ascii_model, write_ascii_properties, write_ascii_results, &
22- & get_multicharge_version
23- use multicharge_output, only : json_results
17+ use , intrinsic :: iso_fortran_env, only: output_unit, error_unit, input_unit
18+ use mctc_env, only: error_type, fatal_error, get_argument, wp
19+ use mctc_io, only: structure_type, read_structure, filetype, get_filetype
20+ use mctc_cutoff, only: get_lattice_points
21+ use multicharge, only: mchrg_model_type, mchrg_model, new_eeq2019_model, &
22+ & new_eeqbc2025_model, get_multicharge_version, &
23+ & write_ascii_model, write_ascii_properties, write_ascii_results
24+ use multicharge_output, only: json_results
2425 implicit none
2526 character (len=* ), parameter :: prog_name = " multicharge"
2627 character (len=* ), parameter :: json_output = " multicharge.json"
2728
2829 character (len= :), allocatable :: input, chargeinput
2930 integer , allocatable :: input_format
30- integer :: stat, unit
31+ integer :: stat, unit, model_id
3132 type (error_type), allocatable :: error
3233 type (structure_type) :: mol
33- type (mchrg_model_type) :: model
34+ class (mchrg_model_type), allocatable :: model
3435 logical :: grad, json, exist
3536 real (wp), parameter :: cn_max = 8.0_wp , cutoff = 25.0_wp
36- real (wp), allocatable :: cn(:), dcndr(:, :, :), dcndL(:, :, :)
37+ real (wp), allocatable :: cn(:), rcov(:), trans(:, :)
38+ real (wp), allocatable :: qloc(:)
39+ real (wp), allocatable :: dcndr(:, :, :), dcndL(:, :, :), dqlocdr(:, :, :), dqlocdL(:, :, :)
3740 real (wp), allocatable :: energy(:), gradient(:, :), sigma(:, :)
38- real (wp), allocatable :: qvec(:), dqdr(:, :, :), dqdL(:, :, :)
41+ real (wp), allocatable :: qvec(:)
42+ real (wp), allocatable :: dqdr(:, :, :), dqdL(:, :, :)
3943 real (wp), allocatable :: charge
4044
41- call get_arguments(input, input_format, grad, charge, json, error)
45+ call get_arguments(input, model_id, input_format, grad, charge, json, error)
4246 if (allocated (error)) then
4347 write (error_unit, ' (a)' ) error% message
4448 error stop
4549 end if
4650
4751 if (input == " -" ) then
48- if (.not. allocated (input_format)) input_format = filetype% xyz
52+ if (.not. allocated (input_format)) input_format = filetype% xyz
4953 call read_structure(mol, input_unit, input_format, error)
5054 else
5155 call read_structure(mol, input, error, input_format)
@@ -76,36 +80,47 @@ program main
7680 end if
7781 end if
7882
79- call new_eeq2019_model(mol, model, error)
80- if (allocated (error)) then
83+ if (model_id == mchrg_model% eeq2019) then
84+ call new_eeq2019_model(mol, model, error)
85+ else if (model_id == mchrg_model% eeqbc2025) then
86+ call new_eeqbc2025_model(mol, model, error)
87+ else
88+ call fatal_error(error, " Invalid model was choosen." )
89+ end if
90+ if (allocated (error)) then
8191 write (error_unit, ' (a)' ) error% message
8292 error stop
8393 end if
8494
8595 call write_ascii_model(output_unit, mol, model)
8696
87- allocate (cn(mol% nat))
88- if (grad) then
89- allocate (dcndr(3 , mol% nat, mol% nat), dcndL(3 , 3 , mol% nat))
90- end if
91-
92- call model% ncoord% get_cn(mol, cn, dcndr, dcndL)
93-
9497 allocate (energy(mol% nat), qvec(mol% nat))
9598 energy(:) = 0.0_wp
99+
100+ allocate (cn(mol% nat), qloc(mol% nat))
96101 if (grad) then
97102 allocate (gradient(3 , mol% nat), sigma(3 , 3 ))
98103 gradient(:, :) = 0.0_wp
99104 sigma(:, :) = 0.0_wp
105+
106+ allocate (dqdr(3 , mol% nat, mol% nat), dqdL(3 , 3 , mol% nat))
107+ dqdr(:, :, :) = 0.0_wp
108+ dqdL(:, :, :) = 0.0_wp
109+
110+ allocate (dcndr(3 , mol% nat, mol% nat), dcndL(3 , 3 , mol% nat))
111+ allocate (dqlocdr(3 , mol% nat, mol% nat), dqlocdL(3 , 3 , mol% nat))
100112 end if
101113
102- call model% solve(mol, error, cn, dcndr, dcndL, energy, gradient, sigma, &
103- & qvec, dqdr, dqdL)
114+ call get_lattice_points(mol% periodic, mol% lattice, model% ncoord% cutoff, trans)
115+ call model% ncoord% get_coordination_number(mol, trans, cn, dcndr, dcndL)
116+ call model% local_charge(mol, trans, qloc, dqlocdr, dqlocdL)
117+ call model% solve(mol, error, cn, qloc, dcndr, dcndL, dqlocdr, dqlocdL, &
118+ & energy, gradient, sigma, qvec, dqdr, dqdL)
119+
104120 if (allocated (error)) then
105121 write (error_unit, ' (a)' ) error% message
106122 error stop
107123 end if
108-
109124
110125 call write_ascii_properties(output_unit, mol, model, cn, qvec)
111126 call write_ascii_results(output_unit, mol, energy, gradient, sigma)
@@ -115,12 +130,11 @@ program main
115130 call json_results(unit, " " , energy= sum (energy), gradient= gradient, charges= qvec, cn= cn)
116131 close (unit)
117132 write (output_unit, ' (a)' ) &
118- " [Info] JSON dump of results written to '" // json_output // " '"
133+ " [Info] JSON dump of results written to '" // json_output// " '"
119134 end if
120135
121136contains
122137
123-
124138subroutine help (unit )
125139 integer , intent (in ) :: unit
126140
@@ -133,7 +147,8 @@ subroutine help(unit)
133147 " higher multipole moments" , &
134148 " "
135149
136- write (unit, ' (2x, a, t25, a)' ) &
150+ write (unit, ' (2x, a, t35, a)' ) &
151+ " -m, -model, --model <model>" , " Choose the charge model" , &
137152 " -i, -input, --input <format>" , " Hint for the format of the input file" , &
138153 " -c, -charge, --charge <value>" , " Set the molecular charge" , &
139154 " -g, -grad, --grad" , " Evaluate molecular gradient and virial" , &
@@ -145,7 +160,6 @@ subroutine help(unit)
145160
146161end subroutine help
147162
148-
149163subroutine version (unit )
150164 integer , intent (in ) :: unit
151165 character (len= :), allocatable :: version_string
@@ -156,12 +170,15 @@ subroutine version(unit)
156170
157171end subroutine version
158172
159-
160- subroutine get_arguments ( input , input_format , grad , charge , json , error )
173+ subroutine get_arguments ( input , model_id , input_format , grad , charge , &
174+ & json , error )
161175
162176 ! > Input file name
163177 character (len= :), allocatable :: input
164178
179+ ! > ID of choosen model type
180+ integer , intent (out ) :: model_id
181+
165182 ! > Input file format
166183 integer , allocatable , intent (out ) :: input_format
167184
@@ -180,6 +197,7 @@ subroutine get_arguments(input, input_format, grad, charge, json, error)
180197 integer :: iarg, narg, iostat
181198 character (len= :), allocatable :: arg
182199
200+ model_id = mchrg_model% eeq2019
183201 grad = .false.
184202 json = .false.
185203 iarg = 0
@@ -195,24 +213,39 @@ subroutine get_arguments(input, input_format, grad, charge, json, error)
195213 call version(output_unit)
196214 stop
197215 case default
198- if (.not. allocated (input)) then
216+ if (.not. allocated (input)) then
199217 call move_alloc(arg, input)
200218 cycle
201219 end if
202220 call fatal_error(error, " Too many positional arguments present" )
203221 exit
222+ case (" -m" , " -model" , " --model" )
223+ iarg = iarg + 1
224+ call get_argument(iarg, arg)
225+ if (.not. allocated (arg)) then
226+ call fatal_error(error, " Missing argument for model" )
227+ exit
228+ end if
229+ if (arg == " eeq2019" .or. arg == " eeq" ) then
230+ model_id = mchrg_model% eeq2019
231+ else if (arg == " eeqbc2025" .or. arg == " eeqbc" ) then
232+ model_id = mchrg_model% eeqbc2025
233+ else
234+ call fatal_error(error, " Invalid model" )
235+ exit
236+ end if
204237 case (" -i" , " -input" , " --input" )
205238 iarg = iarg + 1
206239 call get_argument(iarg, arg)
207- if (.not. allocated (arg)) then
240+ if (.not. allocated (arg)) then
208241 call fatal_error(error, " Missing argument for input format" )
209242 exit
210243 end if
211244 input_format = get_filetype(" ." // arg)
212245 case (" -c" , " -charge" , " --charge" )
213246 iarg = iarg + 1
214247 call get_argument(iarg, arg)
215- if (.not. allocated (arg)) then
248+ if (.not. allocated (arg)) then
216249 call fatal_error(error, " Missing argument for charge" )
217250 exit
218251 end if
@@ -229,8 +262,8 @@ subroutine get_arguments(input, input_format, grad, charge, json, error)
229262 end select
230263 end do
231264
232- if (.not. allocated (input)) then
233- if (.not. allocated (error)) then
265+ if (.not. allocated (input)) then
266+ if (.not. allocated (error)) then
234267 call help(output_unit)
235268 error stop
236269 end if
0 commit comments