KIM API V2
ex_model_driver_P_LJ.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--2018, Regents of the University of Minnesota.
23 ! All rights reserved.
24 !
25 ! Contributors:
26 ! Ryan S. Elliott
27 ! Ellad B. Tadmor
28 ! Valeriu Smirichinski
29 ! Stephen M. Whalen
30 !
31 
32 !****************************************************************************
33 !**
34 !** MODULE ex_model_driver_P_LJ
35 !**
36 !** Lennard-Jones pair potential KIM Model Driver
37 !** shifted to have zero energy at the cutoff radius
38 !**
39 !** Language: Fortran 2003
40 !**
41 !** Release: This file is part of the kim-api-v1.8.0 package.
42 !**
43 !****************************************************************************
44 
45 
47 
48 use, intrinsic :: iso_c_binding
49 implicit none
50 
51 save
52 private
53 public buffer_type, &
55  refresh, &
56  destroy, &
57  calc_phi, &
58  calc_phi_dphi, &
60  speccode
61 
62 ! Below are the definitions and values of all Model parameters
63 integer(c_int), parameter :: cd = c_double ! for literal constants
64 integer(c_int), parameter :: DIM=3 ! dimensionality of space
65 integer(c_int), parameter :: speccode = 1 ! internal species code
66 
67 !-------------------------------------------------------------------------------
68 !
69 ! Definition of Buffer type
70 !
71 !-------------------------------------------------------------------------------
72 type, bind(c) :: buffer_type
73  real(c_double) :: influence_distance(1)
74  real(c_double) :: pcutoff(1)
75  real(c_double) :: cutsq(1)
76  real(c_double) :: epsilon(1)
77  real(c_double) :: sigma(1)
78  real(c_double) :: shift(1)
79 endtype buffer_type
80 
81 
82 contains
83 
84 !-------------------------------------------------------------------------------
85 !
86 ! Calculate pair potential phi(r)
87 !
88 !-------------------------------------------------------------------------------
89 subroutine calc_phi(model_epsilon, &
90  model_sigma, &
91  model_shift, &
92  model_cutoff,r,phi)
93 implicit none
94 
95 !-- Transferred variables
96 real(c_double), intent(in) :: model_epsilon
97 real(c_double), intent(in) :: model_sigma
98 real(c_double), intent(in) :: model_shift
99 real(c_double), intent(in) :: model_cutoff
100 real(c_double), intent(in) :: r
101 real(c_double), intent(out) :: phi
102 
103 !-- Local variables
104 real(c_double) rsq,sor,sor6,sor12
105 
106 rsq = r*r ! r^2
107 sor = model_sigma/r ! (sig/r)
108 sor6 = sor*sor*sor !
109 sor6 = sor6*sor6 ! (sig/r)^6
110 sor12= sor6*sor6 ! (sig/r)^12
111 if (r .gt. model_cutoff) then
112  ! Argument exceeds cutoff radius
113  phi = 0.0_cd
114 else
115  phi = 4.0_cd*model_epsilon*(sor12-sor6) + model_shift
116 endif
117 
118 end subroutine calc_phi
119 
120 !-------------------------------------------------------------------------------
121 !
122 ! Calculate pair potential phi(r) and its derivative dphi(r)
123 !
124 !-------------------------------------------------------------------------------
125 subroutine calc_phi_dphi(model_epsilon, &
126  model_sigma, &
127  model_shift, &
128  model_cutoff,r,phi,dphi)
129 implicit none
130 
131 !-- Transferred variables
132 real(c_double), intent(in) :: model_epsilon
133 real(c_double), intent(in) :: model_sigma
134 real(c_double), intent(in) :: model_shift
135 real(c_double), intent(in) :: model_cutoff
136 real(c_double), intent(in) :: r
137 real(c_double), intent(out) :: phi,dphi
138 
139 !-- Local variables
140 real(c_double) rsq,sor,sor6,sor12
141 
142 rsq = r*r ! r^2
143 sor = model_sigma/r ! (sig/r)
144 sor6 = sor*sor*sor !
145 sor6 = sor6*sor6 ! (sig/r)^6
146 sor12= sor6*sor6 ! (sig/r)^12
147 if (r .gt. model_cutoff) then
148  ! Argument exceeds cutoff radius
149  phi = 0.0_cd
150  dphi = 0.0_cd
151 else
152  phi = 4.0_cd*model_epsilon*(sor12-sor6) + model_shift
153  dphi = 24.0_cd*model_epsilon*(-2.0_cd*sor12+sor6)/r
154 endif
155 
156 end subroutine calc_phi_dphi
157 
158 !-------------------------------------------------------------------------------
159 !
160 ! Calculate pair potential phi(r) and its derivatives dphi(r) and d2phi(r)
161 !
162 !-------------------------------------------------------------------------------
163 subroutine calc_phi_dphi_d2phi(model_epsilon, &
164  model_sigma, &
165  model_shift, &
166  model_cutoff,r,phi,dphi,d2phi)
167 implicit none
168 
169 !-- Transferred variables
170 real(c_double), intent(in) :: model_epsilon
171 real(c_double), intent(in) :: model_sigma
172 real(c_double), intent(in) :: model_shift
173 real(c_double), intent(in) :: model_cutoff
174 real(c_double), intent(in) :: r
175 real(c_double), intent(out) :: phi,dphi,d2phi
176 
177 !-- Local variables
178 real(c_double) rsq,sor,sor6,sor12
179 
180 rsq = r*r ! r^2
181 sor = model_sigma/r ! (sig/r)
182 sor6 = sor*sor*sor !
183 sor6 = sor6*sor6 ! (sig/r)^6
184 sor12= sor6*sor6 ! (sig/r)^12
185 if (r .gt. model_cutoff) then
186  ! Argument exceeds cutoff radius
187  phi = 0.0_cd
188  dphi = 0.0_cd
189  d2phi = 0.0_cd
190 else
191  phi = 4.0_cd*model_epsilon*(sor12-sor6) + model_shift
192  dphi = 24.0_cd*model_epsilon*(-2.0_cd*sor12+sor6)/r
193  d2phi = 24.0_cd*model_epsilon*(26.0_cd*sor12-7.0_cd*sor6)/rsq
194 endif
195 
196 end subroutine calc_phi_dphi_d2phi
197 
198 !-------------------------------------------------------------------------------
199 !
200 ! Compute energy and forces on particles from the positions.
201 !
202 !-------------------------------------------------------------------------------
203 #include "kim_model_compute_log_macros.fd"
204 subroutine compute_energy_forces(model_compute_handle, ierr) bind(c)
209 implicit none
210 
211 !-- Transferred variables
212 type(kim_model_compute_handle_type), intent(in) :: model_compute_handle
213 integer(c_int), intent(out) :: ierr
214 
215 !-- Local variables
216 real(c_double) :: r,rsqij,phi,dphi,d2phi,deidr,d2eidr
217 integer(c_int) :: i,j,jj,numnei
218 integer(c_int) :: ierr2
219 integer(c_int) :: comp_force,comp_energy,comp_enepot,comp_process_dedr, &
220  comp_process_d2edr2
221 type(buffer_type), pointer :: buf; type(c_ptr) :: pbuf
222 
223 real(c_double), pointer :: rij(:)
224 real(c_double), pointer :: rij_pairs(:,:)
225 real(c_double), pointer :: r_pairs(:)
226 integer(c_int), pointer :: i_pairs(:), j_pairs(:)
227 
228 !-- KIM variables
229 real(c_double) :: model_cutoff
230 integer(c_int), pointer :: n
231 real(c_double), pointer :: energy
232 real(c_double), pointer :: coor(:,:)
233 real(c_double), pointer :: force(:,:)
234 real(c_double), pointer :: enepot(:)
235 integer(c_int), pointer :: nei1part(:)
236 integer(c_int), pointer :: particlespeciescodes(:)
237 integer(c_int), pointer :: particlecontributing(:)
238 
239 kim_log_file = __file__
240 
241 ! get model buffer from KIM object
242 call kim_model_compute_get_model_buffer_pointer(model_compute_handle, pbuf)
243 call c_f_pointer(pbuf, buf)
244 
245 model_cutoff = buf%influence_distance(1)
246 
247 ! Check to see if we have been asked to compute the forces, energyperpart,
248 ! energy and d1Edr
249 !
250 ierr = 0
251 call kim_model_compute_is_callback_present(model_compute_handle, &
252  kim_callback_name_process_dedr_term, comp_process_dedr, ierr2)
253 ierr = ierr + ierr2
254 call kim_model_compute_is_callback_present(model_compute_handle, &
255  kim_callback_name_process_d2edr2_term, comp_process_d2edr2, ierr2)
256 ierr = ierr + ierr2
257 if (ierr /= 0) then
258  kim_log_message = "get_compute"
259  log_error()
260  return
261 endif
262 
263 ! Unpack data from KIM object
264 !
265 ierr = 0
266 call kim_model_compute_get_argument_pointer(model_compute_handle, &
268  n, ierr2)
269 ierr = ierr + ierr2
270 
271 call kim_model_compute_get_argument_pointer(model_compute_handle, &
273  n, particlespeciescodes, ierr2)
274 ierr = ierr + ierr2
275 call kim_model_compute_get_argument_pointer(model_compute_handle, &
276  kim_argument_name_particle_contributing, n, particlecontributing, &
277  ierr2)
278 ierr = ierr + ierr2
279 call kim_model_compute_get_argument_pointer(model_compute_handle, &
280  kim_argument_name_coordinates, dim, n, coor, ierr2)
281 ierr = ierr + ierr2
282 call kim_model_compute_get_argument_pointer(model_compute_handle, &
283  kim_argument_name_partial_energy, energy, ierr2)
284 ierr = ierr + ierr2
285 call kim_model_compute_get_argument_pointer(model_compute_handle, &
286  kim_argument_name_partial_forces, dim, n, force, ierr2)
287 ierr = ierr + ierr2
288 call kim_model_compute_get_argument_pointer(model_compute_handle, &
290 ierr = ierr + ierr2
291 if (ierr /= 0) then
292  kim_log_message = "get_argument_pointer"
293  log_error()
294  return
295 endif
296 
297 if (associated(energy)) then
298  comp_energy = 1
299 else
300  comp_energy = 0
301 end if
302 if (associated(force)) then
303  comp_force = 1
304 else
305  comp_force = 0
306 end if
307 if (associated(enepot)) then
308  comp_enepot = 1
309 else
310  comp_enepot = 0
311 end if
312 
313 allocate( rij(dim) )
314 if (comp_process_d2edr2.eq.1) then
315  allocate( r_pairs(2) )
316  allocate( rij_pairs(dim,2) )
317  allocate( i_pairs(2) )
318  allocate( j_pairs(2) )
319 endif
320 
321 ! Check to be sure that the species are correct
322 !
323 
324 ierr = 1 ! assume an error
325 do i = 1,n
326  if (particlespeciescodes(i).ne.speccode) then
327  kim_log_message = "Unexpected species code detected"
328  log_error()
329  return
330  endif
331 enddo
332 ierr = 0 ! everything is ok
333 
334 ! Initialize potential energies, forces
335 !
336 if (comp_enepot.eq.1) enepot = 0.0_cd
337 if (comp_energy.eq.1) energy = 0.0_cd
338 if (comp_force.eq.1) force = 0.0_cd
339 
340 !
341 ! Compute energy and forces
342 !
343 
344 ! Loop over particles and compute energy and forces
345 !
346 do i = 1, n
347 
348  if (particlecontributing(i) == 1) then
349  ! Set up neighbor list for next particle
350  !
352  model_compute_handle, 1, i, numnei, nei1part, ierr)
353  if (ierr /= 0) then
354  ! some sort of problem, exit
355  kim_log_message = "kim_api_get_neigh"
356  log_error()
357  ierr = 1
358  return
359  endif
360 
361  ! Loop over the neighbors of particle i
362  !
363  do jj = 1, numnei
364 
365  j = nei1part(jj) ! get neighbor ID
366 
367  ! compute relative position vector
368  !
369  rij(:) = coor(:,j) - coor(:,i) ! distance vector between i j
370 
371  ! compute energy and forces
372  !
373  rsqij = dot_product(rij,rij) ! compute square distance
374  if ( rsqij .lt. buf%cutsq(1) ) then ! particles are interacting?
375 
376  r = sqrt(rsqij) ! compute distance
377  if (comp_process_d2edr2.eq.1) then
378  call calc_phi_dphi_d2phi(buf%epsilon(1), &
379  buf%sigma(1), &
380  buf%shift(1), &
381  buf%Pcutoff(1), &
382  r,phi,dphi,d2phi) ! compute pair potential
383  ! and it derivatives
384  deidr = 0.5_cd*dphi ! regular contribution
385  d2eidr = 0.5_cd*d2phi
386  elseif (comp_force.eq.1.or.comp_process_dedr.eq.1) then
387  call calc_phi_dphi(buf%epsilon(1), &
388  buf%sigma(1), &
389  buf%shift(1), &
390  buf%Pcutoff(1), &
391  r,phi,dphi) ! compute pair potential
392  ! and it derivative
393 
394  deidr = 0.5_cd*dphi ! regular contribution
395  else
396  call calc_phi(buf%epsilon(1), &
397  buf%sigma(1), &
398  buf%shift(1), &
399  buf%Pcutoff(1), &
400  r,phi) ! compute just pair potential
401  endif
402 
403  ! contribution to energy
404  !
405  if (comp_enepot.eq.1) then
406  enepot(i) = enepot(i) + 0.5_cd*phi ! accumulate energy
407  endif
408  if (comp_energy.eq.1) then
409  energy = energy + 0.5_cd*phi ! add half v to total energy
410  endif
411 
412  ! contribution to process_dEdr
413  !
414  if (comp_process_dedr.eq.1) then
415  call kim_model_compute_process_dedr_term( &
416  model_compute_handle, deidr, r, c_loc(rij(1)), i, j, ierr)
417  endif
418 
419  ! contribution to process_d2Edr2
420  if (comp_process_d2edr2.eq.1) then
421  r_pairs(1) = r
422  r_pairs(2) = r
423  rij_pairs(:,1) = rij
424  rij_pairs(:,2) = rij
425  i_pairs(1) = i
426  i_pairs(2) = i
427  j_pairs(1) = j
428  j_pairs(2) = j
429 
430  call kim_model_compute_process_d2edr2_term( &
431  model_compute_handle, d2eidr, &
432  c_loc(r_pairs(1)), &
433  c_loc(rij_pairs(1,1)), &
434  c_loc(i_pairs(1)), &
435  c_loc(j_pairs(1)), ierr)
436  endif
437 
438  ! contribution to forces
439  !
440  if (comp_force.eq.1) then
441  force(:,i) = force(:,i) + deidr*rij/r ! accumulate force on particle i
442  force(:,j) = force(:,j) - deidr*rij/r ! accumulate force on particle j
443  endif
444 
445  endif
446 
447  enddo ! loop on jj
448 
449  endif ! if particleContributing
450 
451 enddo ! do i
452 
453 ! Free temporary storage
454 !
455 deallocate( rij )
456 if (comp_process_d2edr2.eq.1) then
457  deallocate( r_pairs )
458  deallocate( rij_pairs )
459  deallocate( i_pairs )
460  deallocate( j_pairs )
461 endif
462 
463 ! Everything is great
464 !
465 ierr = 0
466 return
467 
468 end subroutine compute_energy_forces
469 
470 !-------------------------------------------------------------------------------
471 !
472 ! Model driver refresh routine
473 !
474 !-------------------------------------------------------------------------------
475 subroutine refresh(model_refresh_handle, ierr) bind(c)
477 implicit none
478 
479 !-- Transferred variables
480 type(kim_model_refresh_handle_type), intent(inout) :: model_refresh_handle
481 integer(c_int), intent(out) :: ierr
482 
483 !-- Local variables
484 real(c_double) energy_at_cutoff
485 type(buffer_type), pointer :: buf; type(c_ptr) :: pbuf
486 
487 ! get model buffer from KIM object
488 call kim_model_refresh_get_model_buffer_pointer(model_refresh_handle, pbuf)
489 call c_f_pointer(pbuf, buf)
490 
491 call kim_model_refresh_set_influence_distance_pointer(model_refresh_handle, &
492  buf%influence_distance(1))
493 call kim_model_refresh_set_neighbor_list_cutoffs_pointer(model_refresh_handle, &
494  1, buf%influence_distance(1))
495 
496 ! Set new values in KIM object and buffer
497 !
498 buf%influence_distance(1) = buf%Pcutoff(1)
499 buf%cutsq(1) = (buf%Pcutoff(1))**2
500 ! calculate pair potential at r=cutoff with shift=0.0
501 call calc_phi(buf%epsilon(1), &
502  buf%sigma(1), &
503  0.0_cd, &
504  buf%Pcutoff(1), &
505  buf%Pcutoff(1),energy_at_cutoff)
506 buf%shift(1) = -energy_at_cutoff
507 
508 ierr = 0
509 return
510 
511 end subroutine refresh
512 
513 !-------------------------------------------------------------------------------
514 !
515 ! Model driver destroy routine
516 !
517 !-------------------------------------------------------------------------------
518 subroutine destroy(model_destroy_handle, ierr) bind(c)
520 implicit none
521 
522 !-- Transferred variables
523 type(kim_model_destroy_handle_type), intent(inout) :: model_destroy_handle
524 integer(c_int), intent(out) :: ierr
525 
526 !-- Local variables
527 type(buffer_type), pointer :: buf; type(c_ptr) :: pbuf
528 
529 ! get model buffer from KIM object
530 call kim_model_destroy_get_model_buffer_pointer(model_destroy_handle, pbuf)
531 call c_f_pointer(pbuf, buf)
532 
533 deallocate( buf )
534 
535 ierr = 0
536 return
537 
538 end subroutine destroy
539 
540 end module ex_model_driver_p_lj
541 
542 !-------------------------------------------------------------------------------
543 !
544 ! Model driver create routine (REQUIRED)
545 !
546 !-------------------------------------------------------------------------------
547 #include "kim_model_driver_create_log_macros.fd"
548 subroutine model_driver_create_routine(model_driver_create_handle, &
549  requested_length_unit, requested_energy_unit, requested_charge_unit, &
550  requested_temperature_unit, requested_time_unit, ierr) bind(c)
551 use, intrinsic :: iso_c_binding
562 implicit none
563 integer(c_int), parameter :: cd = c_double ! used for literal constants
564 
565 !-- Transferred variables
566 type(kim_model_driver_create_handle_type), intent(inout) &
567  :: model_driver_create_handle
568 type(kim_length_unit_type), intent(in), value :: requested_length_unit
569 type(kim_energy_unit_type), intent(in), value :: requested_energy_unit
570 type(kim_charge_unit_type), intent(in), value :: requested_charge_unit
571 type(kim_temperature_unit_type), intent(in), value :: requested_temperature_unit
572 type(kim_time_unit_type), intent(in), value :: requested_time_unit
573 integer(c_int), intent(out) :: ierr
574 
575 !-- Local variables
576 integer(c_int) :: number_of_parameter_files
577 character(len=1024) :: parameter_file_name
578 integer(c_int) :: ierr2
579 integer(c_int), parameter :: one=1
580 type(BUFFER_TYPE), pointer :: buf;
581 type(kim_species_name_type) species_name
582 ! define variables for all model parameters to be read in
583 real(c_double) factor
584 character(len=100) in_species
585 real(c_double) in_cutoff
586 real(c_double) in_epsilon
587 real(c_double) in_sigma
588 real(c_double) energy_at_cutoff
589 
590 kim_log_file = __file__
591 
592 ! register numbering
593 call kim_model_driver_create_set_model_numbering( &
594  model_driver_create_handle, kim_numbering_one_based, ierr)
595 if (ierr /= 0) then
596  kim_log_message = "Unable to set numbering"
597  log_error()
598  goto 42
599 end if
600 
601 ! register arguments
603  model_driver_create_handle, kim_argument_name_partial_energy, &
606  model_driver_create_handle, kim_argument_name_partial_forces, &
608 ierr = ierr + ierr2
610  model_driver_create_handle, kim_argument_name_partial_particle_energy, &
612 ierr = ierr + ierr2
613 if (ierr /= 0) then
614  kim_log_message = "Unable to register arguments support_statuss"
615  log_error()
616  goto 42
617 end if
618 
619 ! register callbacks
621  model_driver_create_handle, kim_callback_name_process_dedr_term, &
624  model_driver_create_handle, kim_callback_name_process_d2edr2_term, &
626 ierr = ierr + ierr2
627 if (ierr /= 0) then
628  kim_log_message = "Unable to register callbacks support_statuss"
629  log_error()
630  goto 42
631 end if
632 
633 ! store callback pointers in KIM object
635  model_driver_create_handle, kim_language_name_fortran, &
636  c_funloc(compute_energy_forces), ierr)
637 call kim_model_driver_create_set_refresh_pointer( &
638  model_driver_create_handle, kim_language_name_fortran, &
639  c_funloc(refresh), ierr2)
640 ierr = ierr + ierr2
642  model_driver_create_handle, kim_language_name_fortran, &
643  c_funloc(destroy), ierr2)
644 ierr = ierr + ierr2
645 if (ierr /= 0) then
646  kim_log_message = "Unable to store callback pointers"
647  log_error()
648  goto 42
649 end if
650 
651 
652 ! process parameter files
653 call kim_model_driver_create_get_number_of_parameter_files( &
654  model_driver_create_handle, number_of_parameter_files)
655 if (number_of_parameter_files .ne. 1) then
656  kim_log_message = "Wrong number of parameter files"
657  log_error()
658  ierr = 1
659  goto 42
660 end if
661 
662 ! Read in model parameters from parameter file
663 !
664 call kim_model_driver_create_get_parameter_file_name( &
665  model_driver_create_handle, 1, parameter_file_name, ierr)
666 if (ierr /= 0) then
667  kim_log_message = "Unable to get parameter file name"
668  log_error()
669  ierr = 1
670  goto 42
671 end if
672 open(10,file=parameter_file_name,status="old")
673 read(10,*,iostat=ierr,err=100) in_species
674 read(10,*,iostat=ierr,err=100) in_cutoff
675 read(10,*,iostat=ierr,err=100) in_epsilon
676 read(10,*,iostat=ierr,err=100) in_sigma
677 close(10)
678 
679 goto 200
680 100 continue
681 ! reading parameters failed
682 ierr = 1
683 kim_log_message = "Unable to read LJ parameters"
684 log_error()
685 goto 42
686 
687 200 continue
688 
689 
690 ! register species
691 call kim_species_name_from_string(in_species, species_name)
692 if (ierr /= 0) then
693  kim_log_message = "Unable to set species_name"
694  log_error()
695  goto 42
696 end if
697 
699  model_driver_create_handle, species_name, speccode, ierr)
700 if (ierr /= 0) then
701  kim_log_message = "Unable to set species code"
702  log_error()
703  goto 42
704 end if
705 
706 ! convert to appropriate units
708  model_driver_create_handle, &
709  kim_length_unit_a, &
710  kim_energy_unit_ev, &
711  kim_charge_unit_e, &
712  kim_temperature_unit_k, &
713  kim_time_unit_ps, &
714  requested_length_unit, &
715  requested_energy_unit, &
716  requested_charge_unit, &
717  requested_temperature_unit, &
718  requested_time_unit, &
719  1.0_cd, 0.0_cd, 0.0_cd, 0.0_cd, 0.0_cd, factor, ierr)
720 if (ierr /= 0) then
721  kim_log_message = "kim_api_convert_to_act_unit"
722  log_error()
723  goto 42
724 endif
725 in_cutoff = in_cutoff * factor
726 
728  model_driver_create_handle, &
729  kim_length_unit_a, &
730  kim_energy_unit_ev, &
731  kim_charge_unit_e, &
732  kim_temperature_unit_k, &
733  kim_time_unit_ps, &
734  requested_length_unit, &
735  requested_energy_unit, &
736  requested_charge_unit, &
737  requested_temperature_unit, &
738  requested_time_unit, &
739  0.0_cd, 1.0_cd, 0.0_cd, 0.0_cd, 0.0_cd, factor, ierr)
740 if (ierr /= 0) then
741  kim_log_message = "kim_api_convert_to_act_unit"
742  log_error()
743  goto 42
744 endif
745 in_epsilon = in_epsilon * factor
746 
748  model_driver_create_handle, &
749  kim_length_unit_a, &
750  kim_energy_unit_ev, &
751  kim_charge_unit_e, &
752  kim_temperature_unit_k, &
753  kim_time_unit_ps, &
754  requested_length_unit, &
755  requested_energy_unit, &
756  requested_charge_unit, &
757  requested_temperature_unit, &
758  requested_time_unit, &
759  1.0_cd, 0.0_cd, 0.0_cd, 0.0_cd, 0.0_cd, factor, ierr)
760 if (ierr /= 0) then
761  kim_log_message = "kim_api_convert_to_act_unit"
762  log_error()
763  goto 42
764 endif
765 in_sigma = in_sigma * factor
766 
767 allocate( buf )
768 
769 ! setup buffer
770 ! set value of parameters
771 buf%influence_distance(1) = in_cutoff
772 buf%Pcutoff(1) = in_cutoff
773 buf%cutsq(1) = in_cutoff**2
774 buf%epsilon(1) = in_epsilon
775 buf%sigma(1) = in_sigma
776 call calc_phi(in_epsilon, &
777  in_sigma, &
778  0.0_cd, &
779  in_cutoff, &
780  in_cutoff, energy_at_cutoff)
781 buf%shift(1) = -energy_at_cutoff
782 
783 ! store model cutoff in KIM object
785  model_driver_create_handle, buf%influence_distance(1))
786 call kim_model_driver_create_set_neighbor_list_cutoffs_pointer( &
787  model_driver_create_handle, 1, buf%influence_distance(1))
788 
789 ! end setup buffer
790 
791 ! store in model buffer
793  model_driver_create_handle, c_loc(buf))
794 
795 ! set pointers to parameters in KIM object
796 call kim_model_driver_create_set_parameter_pointer( &
797  model_driver_create_handle, buf%pcutoff, "cutoff", ierr)
798 if (ierr /= 0) then
799  kim_log_message = "set_parameter"
800  log_error()
801  goto 42
802 endif
803 
804 call kim_model_driver_create_set_parameter_pointer( &
805  model_driver_create_handle, buf%epsilon, "epsilon", ierr)
806 if (ierr /= 0) then
807  kim_log_message = "set_parameter"
808  log_error()
809  goto 42
810 endif
811 
812 call kim_model_driver_create_set_parameter_pointer( &
813  model_driver_create_handle, buf%sigma, "sigma", ierr)
814 if (ierr /= 0) then
815  kim_log_message = "set_parameter"
816  log_error()
817  goto 42
818 endif
819 
820 ierr = 0
821 42 continue
822 return
823 
824 end subroutine model_driver_create_routine
type(kim_numbering_type), public, protected kim_numbering_one_based
type(kim_argument_name_type), public, protected kim_argument_name_number_of_particles
character(len=4096), public kim_log_file
character(len=65536), public kim_log_message
type(kim_language_name_type), public, protected kim_language_name_fortran
type(kim_support_status_type), public, protected kim_support_status_optional
subroutine, public destroy(model_destroy_handle, ierr)
type(kim_callback_name_type), public, protected kim_callback_name_process_dedr_term
subroutine, public calc_phi_dphi_d2phi(model_epsilon, model_sigma, model_shift, model_cutoff, r, phi, dphi, d2phi)
type(kim_argument_name_type), public, protected kim_argument_name_partial_forces
type(kim_argument_name_type), public, protected kim_argument_name_particle_contributing
subroutine, public refresh(model_refresh_handle, ierr)
type(kim_argument_name_type), public, protected kim_argument_name_particle_species_codes
type(kim_argument_name_type), public, protected kim_argument_name_partial_particle_energy
type(kim_argument_name_type), public, protected kim_argument_name_partial_energy
integer(c_int), parameter, public speccode
subroutine, public compute_energy_forces(model_compute_handle, ierr)
type(kim_callback_name_type), public, protected kim_callback_name_process_d2edr2_term
subroutine model_driver_create_routine(model_driver_create_handle, requested_length_unit, requested_energy_unit, requested_charge_unit, requested_temperature_unit, requested_time_unit, ierr)
type(kim_argument_name_type), public, protected kim_argument_name_coordinates
subroutine, public calc_phi(model_epsilon, model_sigma, model_shift, model_cutoff, r, phi)
subroutine, public calc_phi_dphi(model_epsilon, model_sigma, model_shift, model_cutoff, r, phi, dphi)