52 use,
intrinsic :: iso_c_binding
68 integer(c_int),
parameter :: cd = c_double
69 integer(c_int),
parameter :: dim = 3
87 real(c_double),
parameter :: lj_spring = 0.00051226_cd
88 real(c_double),
parameter :: lj_sigma = 5.26_cd / 1.74724_cd
97 type, bind(c) :: buffer_type
98 real(c_double) :: influence_distance
99 real(c_double) :: cutoff(2)
101 model_will_not_request_neighbors_of_noncontributing_particles(2)
112 recursive subroutine calc_phi(r, phi, dphi, calc_deriv)
116 real(c_double),
intent(in) :: r
117 real(c_double),
intent(out) :: phi
118 real(c_double),
intent(out) :: dphi
119 logical,
intent(in) :: calc_deriv
122 real(c_double) rsq, sor, sor6, sor12
126 sor6 = sor * sor * sor
132 if (calc_deriv) dphi = 0.0_cd
134 phi = 4.0_cd * (sor12 - sor6)
135 if (calc_deriv) dphi = 24.0_cd * (-2.0_cd * sor12 + sor6) / r
145 recursive subroutine calc_spring_energyamp(model_compute_arguments_handle, &
146 atom, coor, eps, ierr)
150 type(kim_model_compute_arguments_handle_type), &
151 intent(in) :: model_compute_arguments_handle
152 integer(c_int),
intent(in) :: atom
153 real(c_double),
intent(in) :: coor(:, :)
154 real(c_double),
intent(out) :: eps
155 integer(c_int),
intent(out) :: ierr
159 real(c_double) rrel(dim)
160 real(c_double) rsqrel
161 integer(c_int) numneishort
162 integer(c_int),
pointer :: neishort(:)
165 call kim_get_neighbor_list( &
166 model_compute_arguments_handle, 1, atom, numneishort, neishort, ierr)
167 if (ierr /= 0)
return 170 do kk = 1, numneishort
172 rrel(:) = coor(:, k) - coor(:, atom)
173 rsqrel = dot_product(rrel, rrel)
174 if (rsqrel < model_cutsq1) eps = eps + rsqrel
176 eps = 0.5_cd * lj_spring * eps
178 end subroutine calc_spring_energyamp
185 recursive subroutine calc_spring_force(model_compute_arguments_handle, atom, &
186 coor, eps, phi, force, ierr)
190 type(kim_model_compute_arguments_handle_type), &
191 intent(in) :: model_compute_arguments_handle
192 integer(c_int),
intent(in) :: atom
193 real(c_double),
intent(in) :: coor(:, :)
194 real(c_double),
intent(in) :: eps
195 real(c_double),
intent(in) :: phi
196 real(c_double),
intent(inout) :: force(:, :)
197 integer(c_int),
intent(out) :: ierr
201 real(c_double) rrel(dim), dforce(dim)
202 real(c_double) rsqrel
203 integer(c_int) numneishort
204 integer(c_int),
pointer :: neishort(:)
207 call kim_get_neighbor_list( &
208 model_compute_arguments_handle, 1, atom, numneishort, neishort, ierr)
209 if (ierr /= 0)
return 213 do kk = 1, numneishort
215 rrel(:) = coor(:, k) - coor(:, atom)
216 rsqrel = dot_product(rrel, rrel)
217 if (rsqrel < model_cutsq1)
then 218 dforce(:) = 0.5_cd * eps * lj_spring * rrel(:) * phi
219 force(:, atom) = force(:, atom) + dforce(:)
220 force(:, k) = force(:, k) - dforce(:)
224 end subroutine calc_spring_force
232 model_compute_handle, model_compute_arguments_handle, ierr) bind(c)
236 type(kim_model_compute_handle_type),
intent(in) :: model_compute_handle
237 type(kim_model_compute_arguments_handle_type),
intent(in) :: &
238 model_compute_arguments_handle
239 integer(c_int),
intent(out) :: ierr
242 real(c_double) :: Rij(dim), dforce(dim)
243 real(c_double) :: r, Rsqij, phi, dphi, dEidr, epsi, epsj
244 integer(c_int) :: i, j, jj, comp_force, comp_enepot, comp_energy
246 integer(c_int) :: numnei
247 integer(c_int) :: ierr2
248 logical :: calc_deriv
251 integer(c_int),
pointer :: N
252 real(c_double),
pointer :: energy
253 real(c_double),
pointer :: coor(:, :)
254 real(c_double),
pointer :: force(:, :)
255 real(c_double),
pointer :: enepot(:)
256 integer(c_int),
pointer :: nei1part(:)
257 integer(c_int),
pointer :: particleSpeciesCodes(:)
258 integer(c_int),
pointer :: particleContributing(:)
264 call kim_get_argument_pointer( &
265 model_compute_arguments_handle, &
266 kim_compute_argument_name_number_of_particles, n, ierr2)
268 call kim_get_argument_pointer( &
269 model_compute_arguments_handle, &
270 kim_compute_argument_name_particle_species_codes, n, &
271 particlespeciescodes, ierr2)
273 call kim_get_argument_pointer( &
274 model_compute_arguments_handle, &
275 kim_compute_argument_name_particle_contributing, n, &
276 particlecontributing, ierr2)
278 call kim_get_argument_pointer( &
279 model_compute_arguments_handle, &
280 kim_compute_argument_name_coordinates, dim, n, coor, ierr2)
282 call kim_get_argument_pointer( &
283 model_compute_arguments_handle, &
284 kim_compute_argument_name_partial_energy, energy, ierr2)
286 call kim_get_argument_pointer( &
287 model_compute_arguments_handle, &
288 kim_compute_argument_name_partial_forces, dim, n, force, ierr2)
290 call kim_get_argument_pointer( &
291 model_compute_arguments_handle, &
292 kim_compute_argument_name_partial_particle_energy, n, enepot, ierr2)
299 call kim_log_entry(model_compute_arguments_handle, &
300 kim_log_verbosity_error,
"get data")
307 if (
associated(energy))
then 312 if (
associated(force))
then 317 if (
associated(enepot))
then 327 calc_deriv = comp_force == 1
333 if (particlespeciescodes(i) /=
speccode)
then 334 call kim_log_entry( &
335 model_compute_handle, kim_log_verbosity_error, &
336 "Unexpected species code detected")
344 if (comp_enepot == 1) enepot = 0.0_cd
345 if (comp_energy == 1) energy = 0.0_cd
346 if (comp_force == 1) force = 0.0_cd
348 if (calc_deriv) deidr = 0.0_cd
357 if (particlecontributing(i) == 1)
then 359 call kim_get_neighbor_list( &
360 model_compute_arguments_handle, 2, i, numnei, nei1part, ierr)
363 call kim_log_entry( &
364 model_compute_arguments_handle, kim_log_verbosity_error, &
365 "GetNeighborList failed")
371 call calc_spring_energyamp(model_compute_arguments_handle, &
375 call kim_log_entry( &
376 model_compute_handle, kim_log_verbosity_error, &
377 "GetNeighborList failed")
389 call calc_spring_energyamp(model_compute_arguments_handle, j, coor, &
393 call kim_log_entry( &
394 model_compute_handle, kim_log_verbosity_error, &
395 "GetNeighborList failed")
402 rij(:) = coor(:, j) - coor(:, i)
406 rsqij = dot_product(rij, rij)
407 if (rsqij < model_cutsq2)
then 410 call calc_phi(r, phi, dphi, calc_deriv)
411 if (calc_deriv) deidr = 0.5_cd * dphi
415 if (comp_enepot == 1)
then 416 enepot(i) = enepot(i) + 0.5_cd * epsi * epsj * phi
418 if (comp_energy == 1)
then 419 energy = energy + 0.5_cd * epsi * epsj * phi
438 if (comp_force == 1)
then 440 call calc_spring_force(model_compute_arguments_handle, i, coor, &
441 epsj, phi, force, ierr)
444 call kim_log_entry( &
445 model_compute_handle, kim_log_verbosity_error, &
446 "GetNeighborList failed")
451 call calc_spring_force(model_compute_arguments_handle, j, coor, &
452 epsi, phi, force, ierr)
455 call kim_log_entry( &
456 model_compute_handle, kim_log_verbosity_error, &
457 "GetNeighborList failed")
462 dforce(:) = epsi * epsj * deidr * rij(:) / r
463 force(:, i) = force(:, i) + dforce(:)
464 force(:, j) = force(:, j) - dforce(:)
488 use,
intrinsic :: iso_c_binding
492 type(kim_model_destroy_handle_type),
intent(inout) :: model_destroy_handle
493 integer(c_int),
intent(out) :: ierr
495 type(buffer_type),
pointer :: buf;
type(c_ptr) :: pbuf
497 call kim_get_model_buffer_pointer(model_destroy_handle, pbuf)
498 call c_f_pointer(pbuf, buf)
499 call kim_log_entry(model_destroy_handle, kim_log_verbosity_information, &
500 "deallocating model buffer")
511 model_compute_handle, model_compute_arguments_create_handle, ierr) bind(c)
512 use,
intrinsic :: iso_c_binding
516 type(kim_model_compute_handle_type),
intent(in) :: model_compute_handle
517 type(kim_model_compute_arguments_create_handle_type),
intent(inout) :: &
518 model_compute_arguments_create_handle
519 integer(c_int),
intent(out) :: ierr
521 integer(c_int) :: ierr2
524 if (model_compute_handle == kim_model_compute_null_handle)
continue 530 call kim_set_argument_support_status( &
531 model_compute_arguments_create_handle, &
532 kim_compute_argument_name_partial_energy, &
533 kim_support_status_optional, ierr2)
535 call kim_set_argument_support_status( &
536 model_compute_arguments_create_handle, &
537 kim_compute_argument_name_partial_forces, &
538 kim_support_status_optional, ierr2)
540 call kim_set_argument_support_status( &
541 model_compute_arguments_create_handle, &
542 kim_compute_argument_name_partial_particle_energy, &
543 kim_support_status_optional, ierr2)
556 call kim_log_entry( &
557 model_compute_arguments_create_handle, &
558 kim_log_verbosity_error, &
559 "Unable to successfully create compute_arguments object")
571 model_compute_handle, model_compute_arguments_destroy_handle, ierr) bind(c)
572 use,
intrinsic :: iso_c_binding
576 type(kim_model_compute_handle_type),
intent(in) :: model_compute_handle
577 type(kim_model_compute_arguments_destroy_handle_type),
intent(inout) :: &
578 model_compute_arguments_destroy_handle
579 integer(c_int),
intent(out) :: ierr
582 if (model_compute_handle == kim_model_compute_null_handle)
continue 583 if (model_compute_arguments_destroy_handle == &
584 kim_model_compute_arguments_destroy_null_handle)
continue 597 recursive subroutine model_create_routine( &
598 model_create_handle, requested_length_unit, requested_energy_unit, &
599 requested_charge_unit, requested_temperature_unit, requested_time_unit, &
601 use,
intrinsic :: iso_c_binding
607 type(kim_model_create_handle_type),
intent(inout) :: model_create_handle
608 type(kim_length_unit_type),
intent(in),
value :: requested_length_unit
609 type(kim_energy_unit_type),
intent(in),
value :: requested_energy_unit
610 type(kim_charge_unit_type),
intent(in),
value :: requested_charge_unit
611 type(kim_temperature_unit_type),
intent(in),
value :: &
612 requested_temperature_unit
613 type(kim_time_unit_type),
intent(in),
value :: requested_time_unit
614 integer(c_int),
intent(out) :: ierr
617 integer(c_int) :: ierr2
618 type(buffer_type),
pointer :: buf
624 if (requested_length_unit == kim_length_unit_unused)
continue 625 if (requested_energy_unit == kim_energy_unit_unused)
continue 626 if (requested_charge_unit == kim_charge_unit_unused)
continue 627 if (requested_temperature_unit == kim_temperature_unit_unused)
continue 628 if (requested_time_unit == kim_time_unit_unused)
continue 631 call kim_set_units(model_create_handle, &
633 kim_energy_unit_ev, &
634 kim_charge_unit_unused, &
635 kim_temperature_unit_unused, &
636 kim_time_unit_unused, &
641 call kim_set_species_code(model_create_handle, &
642 kim_species_name_ar,
speccode, ierr2)
646 call kim_set_model_numbering(model_create_handle, &
647 kim_numbering_one_based, ierr2)
651 call kim_set_routine_pointer( &
652 model_create_handle, &
653 kim_model_routine_name_compute, kim_language_name_fortran, &
656 call kim_set_routine_pointer( &
657 model_create_handle, &
658 kim_model_routine_name_compute_arguments_create, &
659 kim_language_name_fortran, &
662 call kim_set_routine_pointer( &
663 model_create_handle, &
664 kim_model_routine_name_compute_arguments_destroy, &
665 kim_language_name_fortran, &
668 call kim_set_routine_pointer( &
669 model_create_handle, &
670 kim_model_routine_name_destroy, kim_language_name_fortran, 1, &
678 call kim_set_model_buffer_pointer(model_create_handle, &
685 buf%model_will_not_request_neighbors_of_noncontributing_particles(1) = 0
686 buf%model_will_not_request_neighbors_of_noncontributing_particles(2) = 1
689 call kim_set_influence_distance_pointer( &
690 model_create_handle, buf%influence_distance)
693 call kim_set_neighbor_list_pointers( &
694 model_create_handle, 2, buf%cutoff, &
695 buf%model_will_not_request_neighbors_of_noncontributing_particles)
700 call kim_log_entry( &
701 model_create_handle, kim_log_verbosity_error, &
702 "Unable to successfully initialize model")
707 end subroutine model_create_routine
recursive subroutine, public model_compute_arguments_create(model_compute_handle, model_compute_arguments_create_handle, ierr)
recursive subroutine, public model_compute_arguments_destroy(model_compute_handle, model_compute_arguments_destroy_handle, ierr)
real(c_double), parameter, public model_cutoff1
real(c_double), parameter, public model_cutoff2
integer(c_int), parameter, public speccode
static void calc_phi(double const *epsilon, double const *C, double const *Rzero, double const *shift, double const cutoff, double const r, double *phi)
recursive subroutine, public compute_energy_forces(model_compute_handle, model_compute_arguments_handle, ierr)
recursive subroutine, public model_destroy_func(model_destroy_handle, ierr)