kim-api  2.1.4-git+v2.1.3-git-1-g7847914a.GNU
An Application Programming Interface (API) for the Knowledgebase of Interatomic Models (KIM).
ex_model_Ar_SLJ_MultiCutoff.f90
Go to the documentation of this file.
1 !
2 ! CDDL HEADER START
3 !
4 ! The contents of this file are subject to the terms of the Common Development
5 ! and Distribution License Version 1.0 (the "License").
6 !
7 ! You can obtain a copy of the license at
8 ! http://www.opensource.org/licenses/CDDL-1.0. See the License for the
9 ! specific language governing permissions and limitations under the License.
10 !
11 ! When distributing Covered Code, include this CDDL HEADER in each file and
12 ! include the License file in a prominent location with the name LICENSE.CDDL.
13 ! If applicable, add the following below this CDDL HEADER, with the fields
14 ! enclosed by brackets "[]" replaced with your own identifying information:
15 !
16 ! Portions Copyright (c) [yyyy] [name of copyright owner]. All rights reserved.
17 !
18 ! CDDL HEADER END
19 !
20 
21 !
22 ! Copyright (c) 2013--2019, Regents of the University of Minnesota.
23 ! All rights reserved.
24 !
25 ! Contributors:
26 ! Ellad B. Tadmor
27 !
28 
29 !****************************************************************************
30 !**
31 !** MODULE ex_model_Ar_SLJ_MultiCutoff
32 !**
33 !** Spring-modified Lennard-Jones (SLJ) pair potential model for Ar
34 !**
35 !** V = 0.5 \sum_i \sum_j eps_i eps_j 4 [ (sig/r_ij)^12 - (sig/r_ij)^6 ] (1)
36 !**
37 !** where
38 !** eps_i = 0.5 \sum_k spring (r_ik)^2 (2)
39 !**
40 !** See README for details.
41 !**
42 !** Language: Fortran 2003
43 !**
44 !** Author: Ellad B. Tadmor
45 !**
46 !** Date: August 23, 2018
47 !**
48 !****************************************************************************
49 
50 
52 
53 use, intrinsic :: iso_c_binding
55 implicit none
56 
57 save
58 private
59 public compute_energy_forces, &
63  model_cutoff1, &
64  model_cutoff2, &
65  speccode, &
66  buffer_type
67 
68 ! Below are the definitions and values of all Model parameters
69 integer(c_int), parameter :: cd = c_double ! used for literal constants
70 integer(c_int), parameter :: dim = 3 ! dimensionality of space
71 integer(c_int), parameter :: speccode = 1 ! internal species code
72 
73 !-------------------------------------------------------------------------------
74 ! Below are the definitions and values of all additional model parameters
75 !
76 ! Recall that the Fortran 2003 format for declaring parameters is as follows:
77 !
78 ! integer(c_int), parameter :: parname = value ! This defines an integer
79 ! ! parameter called `parname'
80 ! ! with a value equal to
81 ! ! `value' (a number)
82 !
83 ! real(c_double), parameter :: parname = value ! This defines a real(c_double)
84 ! ! parameter called `parname'
85 ! ! with a value equal to
86 ! ! `value' (a number)
87 !-------------------------------------------------------------------------------
88 real(c_double), parameter :: lj_spring = 0.00051226_cd
89 real(c_double), parameter :: lj_sigma = 5.26_cd/1.74724_cd
90  ! experimental fcc lattice constant is a0=5.26
91 real(c_double), parameter :: model_cutoff1 = 1.25*lj_sigma
92  ! short-range nearest neighbor for fcc
93 real(c_double), parameter :: model_cutoff2 = 2.25*lj_sigma
94  ! long-range third neighbor for fcc
95 real(c_double), parameter :: model_cutsq1 = model_cutoff1**2
96 real(c_double), parameter :: model_cutsq2 = model_cutoff2**2
97 
98 type, bind(c) :: buffer_type
99  real(c_double) :: influence_distance
100  real(c_double) :: cutoff(2)
101  integer(c_int) :: &
102  model_will_not_request_neighbors_of_noncontributing_particles(2)
103 end type buffer_type
104 
105 contains
106 
107 !-------------------------------------------------------------------------------
108 !
109 ! Calculate Lennard-Jones potential phi(r) and, if requested,
110 ! its derivative dphi(r)
111 !
112 !-------------------------------------------------------------------------------
113 recursive subroutine calc_phi(r,phi,dphi,calc_deriv)
114 implicit none
115 
116 !-- Transferred variables
117 real(c_double), intent(in) :: r
118 real(c_double), intent(out) :: phi
119 real(c_double), intent(out) :: dphi
120 logical, intent(in) :: calc_deriv
121 
122 !-- Local variables
123 real(c_double) rsq,sor,sor6,sor12
124 
125 rsq = r*r ! r^2
126 sor = lj_sigma/r ! (sig/r)
127 sor6 = sor*sor*sor !
128 sor6 = sor6*sor6 ! (sig/r)^6
129 sor12= sor6*sor6 ! (sig/r)^12
130 if (r .gt. model_cutoff2) then
131  ! Argument exceeds cutoff radius
132  phi = 0.0_cd
133  if (calc_deriv) dphi = 0.0_cd
134 else
135  phi = 4.0_cd*(sor12-sor6)
136  if (calc_deriv) dphi = 24.0_cd*(-2.0_cd*sor12+sor6)/r
137 endif
138 
139 end subroutine calc_phi
140 
141 !-------------------------------------------------------------------------------
142 !
143 ! Calculate short-range linear spring-based energy amplitude for `atom`
144 !
145 !-------------------------------------------------------------------------------
146 recursive subroutine calc_spring_energyamp(model_compute_arguments_handle, &
147  atom, coor, eps, ierr)
148 implicit none
149 
150 !-- Transferred variables
151 type(kim_model_compute_arguments_handle_type), &
152  intent(in) :: model_compute_arguments_handle
153 integer(c_int), intent(in) :: atom
154 real(c_double), intent(in) :: coor(:,:)
155 real(c_double), intent(out) :: eps
156 integer(c_int), intent(out) :: ierr
157 
158 !-- Local variables
159 integer(c_int) k,kk
160 real(c_double) rrel(dim)
161 real(c_double) rsqrel
162 integer(c_int) numneishort
163 integer(c_int), pointer :: neishort(:)
164 
165 ! Get short-range neighbors of `atom`
166 call kim_get_neighbor_list( &
167  model_compute_arguments_handle, 1, atom, numneishort, neishort, ierr)
168 if (ierr /= 0) return
169 
170 eps = 0.0_cd
171 do kk = 1, numneishort
172  k = neishort(kk)
173  rrel(:) = coor(:,k) - coor(:,atom)
174  rsqrel = dot_product(rrel,rrel)
175  if (rsqrel .lt. model_cutsq1) eps = eps + rsqrel
176 enddo
177 eps = 0.5_cd*lj_spring*eps
178 
179 end subroutine calc_spring_energyamp
180 
181 !-------------------------------------------------------------------------------
182 !
183 ! Calculate short-range linear spring-based contribution to force
184 !
185 !-------------------------------------------------------------------------------
186 recursive subroutine calc_spring_force(model_compute_arguments_handle, atom, &
187  coor, eps, phi, force, ierr)
188 implicit none
189 
190 !-- Transferred variables
191 type(kim_model_compute_arguments_handle_type), &
192  intent(in) :: model_compute_arguments_handle
193 integer(c_int), intent(in) :: atom
194 real(c_double), intent(in) :: coor(:,:)
195 real(c_double), intent(in) :: eps
196 real(c_double), intent(in) :: phi
197 real(c_double), intent(inout) :: force(:,:)
198 integer(c_int), intent(out) :: ierr
199 
200 !-- Local variables
201 integer(c_int) k,kk
202 real(c_double) rrel(dim), dforce(dim)
203 real(c_double) rsqrel
204 integer(c_int) numneishort
205 integer(c_int), pointer :: neishort(:)
206 
207 ! Get short-range neighbors of `atom`
208 call kim_get_neighbor_list( &
209  model_compute_arguments_handle, 1, atom, numneishort, neishort, ierr)
210 if (ierr /= 0) return
211 
212 ! Add contribution to force on `atom` and its near neighbors that contribute
213 ! to the spring term
214 do kk = 1, numneishort
215  k = neishort(kk)
216  rrel(:) = coor(:,k) - coor(:,atom)
217  rsqrel = dot_product(rrel,rrel)
218  if (rsqrel .lt. model_cutsq1) then
219  dforce(:) = 0.5_cd*eps*lj_spring*rrel(:)*phi
220  force(:,atom) = force(:,atom) + dforce(:) ! accumulate force on atom
221  force(:,k) = force(:,k) - dforce(:) ! accumulate force on k
222  endif
223 enddo
224 
225 end subroutine calc_spring_force
226 
227 
228 !-------------------------------------------------------------------------------
229 !
230 ! Compute energy and forces on particles from the positions.
231 !
232 !-------------------------------------------------------------------------------
233 recursive subroutine compute_energy_forces(model_compute_handle, &
234  model_compute_arguments_handle, ierr) bind(c)
235 implicit none
236 
237 !-- Transferred variables
238 type(kim_model_compute_handle_type), intent(in) :: model_compute_handle
239 type(kim_model_compute_arguments_handle_type), intent(in) :: &
240  model_compute_arguments_handle
241 integer(c_int), intent(out) :: ierr
242 
243 !-- Local variables
244 real(c_double) :: Rij(dim),dforce(dim)
245 real(c_double) :: r,Rsqij,phi,dphi,dEidr,epsi,epsj
246 integer(c_int) :: i,j,jj,comp_force,comp_enepot,comp_energy
247 !integer(c_int) :: comp_virial
248 integer(c_int) :: numnei
249 integer(c_int) :: ierr2
250 logical :: calc_deriv
251 
252 !-- KIM variables
253 integer(c_int), pointer :: N
254 real(c_double), pointer :: energy
255 real(c_double), pointer :: coor(:,:)
256 real(c_double), pointer :: force(:,:)
257 real(c_double), pointer :: enepot(:)
258 integer(c_int), pointer :: nei1part(:)
259 integer(c_int), pointer :: particleSpeciesCodes(:)
260 integer(c_int), pointer :: particleContributing(:)
261 !real(c_double), pointer :: virial(:)
262 
263 ! Unpack data from KIM object
264 !
265 ierr = 0
266 call kim_get_argument_pointer( &
267  model_compute_arguments_handle, &
268  kim_compute_argument_name_number_of_particles, n, ierr2)
269 ierr = ierr + ierr2
270 call kim_get_argument_pointer( &
271  model_compute_arguments_handle, &
272  kim_compute_argument_name_particle_species_codes, n, particlespeciescodes, &
273  ierr2)
274 ierr = ierr + ierr2
275 call kim_get_argument_pointer( &
276  model_compute_arguments_handle, &
277  kim_compute_argument_name_particle_contributing, n, particlecontributing, &
278  ierr2)
279 ierr = ierr + ierr2
280 call kim_get_argument_pointer( &
281  model_compute_arguments_handle, &
282  kim_compute_argument_name_coordinates, dim, n, coor, ierr2)
283 ierr = ierr + ierr2
284 call kim_get_argument_pointer( &
285  model_compute_arguments_handle, &
286  kim_compute_argument_name_partial_energy, energy, ierr2)
287 ierr = ierr + ierr2
288 call kim_get_argument_pointer( &
289  model_compute_arguments_handle, &
290  kim_compute_argument_name_partial_forces, dim, n, force, ierr2)
291 ierr = ierr + ierr2
292 call kim_get_argument_pointer( &
293  model_compute_arguments_handle, &
294  kim_compute_argument_name_partial_particle_energy, n, enepot, ierr2)
295 ierr = ierr + ierr2
296 !call kim_model_compute_arguments_get_argument_pointer( &
297 ! model_compute_arguments_handle, &
298 ! KIM_COMPUTE_ARGUMENT_NAME_PARTIAL_VIRIAL, 6, virial, ierr2)
299 !ierr = ierr + ierr2
300 if (ierr /= 0) then
301  call kim_log_entry(model_compute_arguments_handle, &
302  kim_log_verbosity_error, "get data")
303  return
304 endif
305 
306 ! Check to see if we have been asked to compute the forces, energyperpart,
307 ! energy and virial
308 !
309 if (associated(energy)) then
310  comp_energy = 1
311 else
312  comp_energy = 0
313 end if
314 if (associated(force)) then
315  comp_force = 1
316 else
317  comp_force = 0
318 end if
319 if (associated(enepot)) then
320  comp_enepot = 1
321 else
322  comp_enepot = 0
323 end if
324 !if (associated(virial)) then
325 ! comp_virial = 1
326 !else
327 ! comp_virial = 0
328 !end if
329 calc_deriv = comp_force.eq.1 !.or.comp_virial.eq.1
330 
331 ! Check to be sure that the species are correct
332 !
333 ierr = 1 ! assume an error
334 do i = 1,n
335  if (particlespeciescodes(i).ne.speccode) then
336  call kim_log_entry(model_compute_handle, &
337  kim_log_verbosity_error, "Unexpected species code detected")
338  return
339  endif
340 enddo
341 ierr = 0 ! everything is ok
342 
343 ! Initialize potential energies, forces, virial term
344 !
345 if (comp_enepot.eq.1) enepot = 0.0_cd
346 if (comp_energy.eq.1) energy = 0.0_cd
347 if (comp_force.eq.1) force = 0.0_cd
348 !if (comp_virial.eq.1) virial = 0.0_cd
349 if (calc_deriv) deidr = 0.0_cd
350 
351 !
352 ! Compute energy and forces
353 !
354 
355 ! Loop over particles and compute energy and forces
356 !
357 do i = 1, n
358  if (particlecontributing(i) == 1) then
359  ! Set up neighbor list for next particle
360  call kim_get_neighbor_list( &
361  model_compute_arguments_handle, 2, i, numnei, nei1part, ierr)
362  if (ierr /= 0) then
363  ! some sort of problem, exit
364  call kim_log_entry( &
365  model_compute_arguments_handle, kim_log_verbosity_error, &
366  "GetNeighborList failed")
367  ierr = 1
368  return
369  endif
370 
371  ! Get short range contribution for atom i to energy amplitude
372  call calc_spring_energyamp(model_compute_arguments_handle, i, coor, epsi, ierr)
373  if (ierr /= 0) then
374  ! some sort of problem, exit
375  call kim_log_entry( &
376  model_compute_handle, kim_log_verbosity_error, &
377  "GetNeighborList failed")
378  ierr = 1
379  return
380  endif
381 
382  ! Loop over the neighbors of particle i
383  !
384  do jj = 1, numnei
385 
386  j = nei1part(jj) ! get neighbor ID
387 
388  ! Get short range contribution for atom j to energy amplitude
389  call calc_spring_energyamp(model_compute_arguments_handle, j, coor, epsj, ierr)
390  if (ierr /= 0) then
391  ! some sort of problem, exit
392  call kim_log_entry( &
393  model_compute_handle, kim_log_verbosity_error, &
394  "GetNeighborList failed")
395  ierr = 1
396  return
397  endif
398 
399  ! compute relative position vector
400  !
401  rij(:) = coor(:,j) - coor(:,i) ! distance vector between i j
402 
403  ! compute energy and forces
404  !
405  rsqij = dot_product(rij,rij) ! compute square distance
406  if ( rsqij .lt. model_cutsq2 ) then ! particles are interacting?
407 
408  r = sqrt(rsqij) ! compute distance
409  call calc_phi(r,phi,dphi,calc_deriv) ! compute pair potential and deriv
410  if (calc_deriv) deidr = 0.5_cd*dphi
411 
412  ! contribution to energy
413  !
414  if (comp_enepot.eq.1) then
415  enepot(i) = enepot(i) + 0.5_cd*epsi*epsj*phi ! accumulate energy
416  endif
417  if (comp_energy.eq.1) then
418  energy = energy + 0.5_cd*epsi*epsj*phi
419  endif
420 
421 !!@@@@@@@@@@@@@@@@@@@@ NOT FIXED YET
422 ! ! contribution to virial tensor, virial(i,j)=r(i)*r(j)*(dV/dr)/r
423 ! !
424 ! if (comp_virial.eq.1) then
425 ! virial(1) = virial(1) + Rij(1)*Rij(1)*dEidr/r
426 ! virial(2) = virial(2) + Rij(2)*Rij(2)*dEidr/r
427 ! virial(3) = virial(3) + Rij(3)*Rij(3)*dEidr/r
428 ! virial(4) = virial(4) + Rij(2)*Rij(3)*dEidr/r
429 ! virial(5) = virial(5) + Rij(1)*Rij(3)*dEidr/r
430 ! virial(6) = virial(6) + Rij(1)*Rij(2)*dEidr/r
431 ! endif
432 !!@@@@@@@@@@@@@@@@@@@@
433 
434 
435  ! contribution to forces
436  !
437  if (comp_force.eq.1) then
438  ! Contribution due to short range neighbors of i
439  call calc_spring_force(model_compute_arguments_handle, i, coor, epsj, &
440  phi, force, ierr)
441  if (ierr /= 0) then
442  ! some sort of problem, exit
443  call kim_log_entry( &
444  model_compute_handle, kim_log_verbosity_error, &
445  "GetNeighborList failed")
446  ierr = 1
447  return
448  endif
449  ! Contribution due to short range neighbors of j
450  call calc_spring_force(model_compute_arguments_handle, j, coor, epsi, &
451  phi, force, ierr)
452  if (ierr /= 0) then
453  ! some sort of problem, exit
454  call kim_log_entry( &
455  model_compute_handle, kim_log_verbosity_error, &
456  "GetNeighborList failed")
457  ierr = 1
458  return
459  endif
460  ! Contribution due to deriv of LJ term
461  dforce(:) = epsi*epsj*deidr*rij(:)/r
462  force(:,i) = force(:,i) + dforce(:) ! accumulate force on i
463  force(:,j) = force(:,j) - dforce(:) ! accumulate force on j
464  endif
465 
466  endif
467 
468  enddo ! loop on jj
469 
470  endif ! if particleContributing
471 
472 enddo ! do i
473 
474 ! Everything is great
475 !
476 ierr = 0
477 return
478 
479 end subroutine compute_energy_forces
480 
481 !-------------------------------------------------------------------------------
482 !
483 ! Model destroy routine (REQUIRED)
484 !
485 !-------------------------------------------------------------------------------
486 recursive subroutine model_destroy_func(model_destroy_handle, ierr) bind(c)
487  use, intrinsic :: iso_c_binding
488  implicit none
489 
490  !-- Transferred variables
491  type(kim_model_destroy_handle_type), intent(inout) :: model_destroy_handle
492  integer(c_int), intent(out) :: ierr
493 
494  type(buffer_type), pointer :: buf; type(c_ptr) :: pbuf
495 
496  call kim_get_model_buffer_pointer(model_destroy_handle, pbuf)
497  call c_f_pointer(pbuf, buf)
498  call kim_log_entry(model_destroy_handle, &
499  kim_log_verbosity_information, "deallocating model buffer")
500  deallocate(buf)
501  ierr = 0 ! everything is good
502 end subroutine model_destroy_func
503 
504 !-------------------------------------------------------------------------------
505 !
506 ! Model compute arguments create routine (REQUIRED)
507 !
508 !-------------------------------------------------------------------------------
509 recursive subroutine model_compute_arguments_create(model_compute_handle, &
510  model_compute_arguments_create_handle, ierr) bind(c)
511  use, intrinsic :: iso_c_binding
512  implicit none
513 
514  !-- Transferred variables
515  type(kim_model_compute_handle_type), intent(in) :: model_compute_handle
516  type(kim_model_compute_arguments_create_handle_type), intent(inout) :: &
517  model_compute_arguments_create_handle
518  integer(c_int), intent(out) :: ierr
519 
520  integer(c_int) :: ierr2
521 
522  ! avoid unsed dummy argument warnings
523  if (model_compute_handle .eq. kim_model_compute_null_handle) continue
524 
525  ierr = 0
526  ierr2 = 0
527 
528  ! register arguments
529  call kim_set_argument_support_status( &
530  model_compute_arguments_create_handle, &
531  kim_compute_argument_name_partial_energy, &
532  kim_support_status_optional, ierr2)
533  ierr = ierr + ierr2
534  call kim_set_argument_support_status( &
535  model_compute_arguments_create_handle, &
536  kim_compute_argument_name_partial_forces, &
537  kim_support_status_optional, ierr2)
538  ierr = ierr + ierr2
539  call kim_set_argument_support_status( &
540  model_compute_arguments_create_handle, &
541  kim_compute_argument_name_partial_particle_energy, &
542  kim_support_status_optional, ierr2)
543  ierr = ierr + ierr2
544 ! call kim_set_argument_support_status( &
545 ! model_compute_arguments_create_handle, &
546 ! KIM_COMPUTE_ARGUMENT_NAME_PARTIAL_VIRIAL, &
547 ! KIM_SUPPORT_STATUS_OPTIONAL, ierr2)
548 ! ierr = ierr + ierr2
549 
550  ! register call backs
551  ! NONE
552 
553  if (ierr /= 0) then
554  ierr = 1
555  call kim_log_entry( &
556  model_compute_arguments_create_handle, &
557  kim_log_verbosity_error, &
558  "Unable to successfully create compute_arguments object")
559  endif
560 
561  return
562 end subroutine model_compute_arguments_create
563 
564 !-------------------------------------------------------------------------------
565 !
566 ! Model compute arguments destroy routine (REQUIRED)
567 !
568 !-------------------------------------------------------------------------------
569 recursive subroutine model_compute_arguments_destroy(model_compute_handle, &
570  model_compute_arguments_destroy_handle, ierr) bind(c)
571  use, intrinsic :: iso_c_binding
572  implicit none
573 
574  !-- Transferred variables
575  type(kim_model_compute_handle_type), intent(in) :: model_compute_handle
576  type(kim_model_compute_arguments_destroy_handle_type), intent(inout) :: &
577  model_compute_arguments_destroy_handle
578  integer(c_int), intent(out) :: ierr
579 
580  ! avoid unsed dummy argument warnings
581  if (model_compute_handle .eq. kim_model_compute_null_handle) continue
582  if (model_compute_arguments_destroy_handle .eq. &
583  kim_model_compute_arguments_destroy_null_handle) continue
584 
585  ierr = 0
586  return
587 end subroutine model_compute_arguments_destroy
588 
590 
591 !-------------------------------------------------------------------------------
592 !
593 ! Model create routine (REQUIRED)
594 !
595 !-------------------------------------------------------------------------------
596 recursive subroutine model_create_routine(model_create_handle, &
597  requested_length_unit, requested_energy_unit, requested_charge_unit, &
598  requested_temperature_unit, requested_time_unit, ierr) bind(c)
599 use, intrinsic :: iso_c_binding
602 implicit none
603 
604 !-- Transferred variables
605 type(kim_model_create_handle_type), intent(inout) :: model_create_handle
606 type(kim_length_unit_type), intent(in), value :: requested_length_unit
607 type(kim_energy_unit_type), intent(in), value :: requested_energy_unit
608 type(kim_charge_unit_type), intent(in), value :: requested_charge_unit
609 type(kim_temperature_unit_type), intent(in), value :: requested_temperature_unit
610 type(kim_time_unit_type), intent(in), value :: requested_time_unit
611 integer(c_int), intent(out) :: ierr
612 
613 !-- KIM variables
614 integer(c_int) :: ierr2
615 type(buffer_type), pointer :: buf
616 
617 ierr = 0
618 ierr2 = 0
619 
620 ! avoid unsed dummy argument warnings
621 if (requested_length_unit .eq. kim_length_unit_unused) continue
622 if (requested_energy_unit .eq. kim_energy_unit_unused) continue
623 if (requested_charge_unit .eq. kim_charge_unit_unused) continue
624 if (requested_temperature_unit .eq. kim_temperature_unit_unused) continue
625 if (requested_time_unit .eq. kim_time_unit_unused) continue
626 
627 ! set units
628 call kim_set_units(model_create_handle, &
629  kim_length_unit_a, &
630  kim_energy_unit_ev, &
631  kim_charge_unit_unused, &
632  kim_temperature_unit_unused, &
633  kim_time_unit_unused, &
634  ierr2)
635 ierr = ierr + ierr2
636 
637 ! register species
638 call kim_set_species_code(model_create_handle, &
639  kim_species_name_ar, speccode, ierr2)
640 ierr = ierr + ierr2
641 
642 ! register numbering
643 call kim_set_model_numbering(model_create_handle, &
644  kim_numbering_one_based, ierr2);
645 ierr = ierr + ierr2
646 
647 ! register function pointers
648 call kim_set_routine_pointer(model_create_handle, &
649  kim_model_routine_name_compute, kim_language_name_fortran, &
650  1, c_funloc(compute_energy_forces), ierr2)
651 ierr = ierr + ierr2
652 call kim_set_routine_pointer(model_create_handle, &
653  kim_model_routine_name_compute_arguments_create, kim_language_name_fortran, &
654  1, c_funloc(model_compute_arguments_create), ierr2)
655 ierr = ierr + ierr2
656 call kim_set_routine_pointer(model_create_handle, &
657  kim_model_routine_name_compute_arguments_destroy, kim_language_name_fortran, &
658  1, c_funloc(model_compute_arguments_destroy), ierr2)
659 ierr = ierr + ierr2
660 call kim_set_routine_pointer(model_create_handle, &
661  kim_model_routine_name_destroy, kim_language_name_fortran, 1, &
662  c_funloc(model_destroy_func), ierr2)
663 ierr = ierr + ierr2
664 
665 ! allocate buffer
666 allocate( buf )
667 
668 ! store model buffer in KIM object
669 call kim_set_model_buffer_pointer(model_create_handle, &
670  c_loc(buf))
671 
672 ! set buffer values
673 buf%influence_distance = model_cutoff1 + model_cutoff2
674 buf%cutoff(1) = model_cutoff1
675 buf%cutoff(2) = model_cutoff2
676 buf%model_will_not_request_neighbors_of_noncontributing_particles(1) = 0
677 buf%model_will_not_request_neighbors_of_noncontributing_particles(2) = 1
678 
679 ! register influence distance
680 call kim_set_influence_distance_pointer( &
681  model_create_handle, buf%influence_distance)
682 
683 ! register cutoff
684 call kim_set_neighbor_list_pointers(model_create_handle, &
685  2, buf%cutoff, &
686  buf%model_will_not_request_neighbors_of_noncontributing_particles)
687 
688 if (ierr /= 0) then
689  ierr = 1
690  deallocate( buf )
691  call kim_log_entry(model_create_handle, &
692  kim_log_verbosity_error, "Unable to successfully initialize model")
693 endif
694 
695 return
696 
697 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)