233 model_compute_handle, model_compute_arguments_handle, ierr)
bind(c)
237 type(kim_model_compute_handle_type),
intent(in) :: model_compute_handle
238 type(kim_model_compute_arguments_handle_type),
intent(in) :: &
239 model_compute_arguments_handle
240 integer(c_int),
intent(out) :: ierr
243 real(c_double) :: rij(dim), dforce(dim)
244 real(c_double) :: r, rsqij, phi, dphi, deidr, epsi, epsj
245 integer(c_int) :: i, j, jj, comp_force, comp_enepot, comp_energy
247 integer(c_int) :: numnei
248 integer(c_int) :: ierr2
249 logical :: calc_deriv
252 integer(c_int),
pointer :: n
253 real(c_double),
pointer :: energy
254 real(c_double),
pointer :: coor(:, :)
255 real(c_double),
pointer :: force(:, :)
256 real(c_double),
pointer :: enepot(:)
257 integer(c_int),
pointer :: nei1part(:)
258 integer(c_int),
pointer :: particlespeciescodes(:)
259 integer(c_int),
pointer :: particlecontributing(:)
265 call kim_get_argument_pointer( &
266 model_compute_arguments_handle, &
267 kim_compute_argument_name_number_of_particles, n, ierr2)
269 call kim_get_argument_pointer( &
270 model_compute_arguments_handle, &
271 kim_compute_argument_name_particle_species_codes, n, &
272 particlespeciescodes, ierr2)
274 call kim_get_argument_pointer( &
275 model_compute_arguments_handle, &
276 kim_compute_argument_name_particle_contributing, n, &
277 particlecontributing, ierr2)
279 call kim_get_argument_pointer( &
280 model_compute_arguments_handle, &
281 kim_compute_argument_name_coordinates, dim, n, coor, ierr2)
283 call kim_get_argument_pointer( &
284 model_compute_arguments_handle, &
285 kim_compute_argument_name_partial_energy, energy, ierr2)
287 call kim_get_argument_pointer( &
288 model_compute_arguments_handle, &
289 kim_compute_argument_name_partial_forces, dim, n, force, ierr2)
291 call kim_get_argument_pointer( &
292 model_compute_arguments_handle, &
293 kim_compute_argument_name_partial_particle_energy, n, enepot, ierr2)
300 call kim_log_entry(model_compute_arguments_handle, &
301 kim_log_verbosity_error,
"get data")
308 if (
associated(energy))
then
313 if (
associated(force))
then
318 if (
associated(enepot))
then
328 calc_deriv = comp_force == 1
334 if (particlespeciescodes(i) /=
speccode)
then
335 call kim_log_entry( &
336 model_compute_handle, kim_log_verbosity_error, &
337 "Unexpected species code detected")
345 if (comp_enepot == 1) enepot = 0.0_cd
346 if (comp_energy == 1) energy = 0.0_cd
347 if (comp_force == 1) force = 0.0_cd
349 if (calc_deriv) deidr = 0.0_cd
358 if (particlecontributing(i) == 1)
then
360 call kim_get_neighbor_list( &
361 model_compute_arguments_handle, 2, i, numnei, nei1part, ierr)
364 call kim_log_entry( &
365 model_compute_arguments_handle, kim_log_verbosity_error, &
366 "GetNeighborList failed")
372 call calc_spring_energyamp(model_compute_arguments_handle, &
376 call kim_log_entry( &
377 model_compute_handle, kim_log_verbosity_error, &
378 "GetNeighborList failed")
390 call calc_spring_energyamp(model_compute_arguments_handle, j, coor, &
394 call kim_log_entry( &
395 model_compute_handle, kim_log_verbosity_error, &
396 "GetNeighborList failed")
403 rij(:) = coor(:, j) - coor(:, i)
407 rsqij = dot_product(rij, rij)
408 if (rsqij < model_cutsq2)
then
411 call calc_phi(r, phi, dphi, calc_deriv)
412 if (calc_deriv) deidr = 0.5_cd * dphi
416 if (comp_enepot == 1)
then
417 enepot(i) = enepot(i) + 0.5_cd * epsi * epsj * phi
419 if (comp_energy == 1)
then
420 energy = energy + 0.5_cd * epsi * epsj * phi
439 if (comp_force == 1)
then
441 call calc_spring_force(model_compute_arguments_handle, i, coor, &
442 epsj, phi, force, ierr)
445 call kim_log_entry( &
446 model_compute_handle, kim_log_verbosity_error, &
447 "GetNeighborList failed")
452 call calc_spring_force(model_compute_arguments_handle, j, coor, &
453 epsi, phi, force, ierr)
456 call kim_log_entry( &
457 model_compute_handle, kim_log_verbosity_error, &
458 "GetNeighborList failed")
463 dforce(:) = epsi * epsj * deidr * rij(:) / r
464 force(:, i) = force(:, i) + dforce(:)
465 force(:, j) = force(:, j) - dforce(:)
512 model_compute_handle, model_compute_arguments_create_handle, ierr)
bind(c)
513 use,
intrinsic :: iso_c_binding
517 type(kim_model_compute_handle_type),
intent(in) :: model_compute_handle
518 type(kim_model_compute_arguments_create_handle_type),
intent(inout) :: &
519 model_compute_arguments_create_handle
520 integer(c_int),
intent(out) :: ierr
522 integer(c_int) :: ierr2
525 if (model_compute_handle == kim_model_compute_null_handle)
continue
531 call kim_set_argument_support_status( &
532 model_compute_arguments_create_handle, &
533 kim_compute_argument_name_partial_energy, &
534 kim_support_status_optional, ierr2)
536 call kim_set_argument_support_status( &
537 model_compute_arguments_create_handle, &
538 kim_compute_argument_name_partial_forces, &
539 kim_support_status_optional, ierr2)
541 call kim_set_argument_support_status( &
542 model_compute_arguments_create_handle, &
543 kim_compute_argument_name_partial_particle_energy, &
544 kim_support_status_optional, ierr2)
557 call kim_log_entry( &
558 model_compute_arguments_create_handle, &
559 kim_log_verbosity_error, &
560 "Unable to successfully create compute_arguments object")