kim-api  2.3.0+v2.3.0.GNU.GNU.
An Application Programming Interface (API) for the Knowledgebase of Interatomic Models (KIM).
kim_model_module.f90
Go to the documentation of this file.
1 !
2 ! KIM-API: An API for interatomic models
3 ! Copyright (c) 2013--2022, Regents of the University of Minnesota.
4 ! All rights reserved.
5 !
6 ! Contributors:
7 ! Ryan S. Elliott
8 !
9 ! SPDX-License-Identifier: LGPL-2.1-or-later
10 !
11 ! This library is free software; you can redistribute it and/or
12 ! modify it under the terms of the GNU Lesser General Public
13 ! License as published by the Free Software Foundation; either
14 ! version 2.1 of the License, or (at your option) any later version.
15 !
16 ! This library is distributed in the hope that it will be useful,
17 ! but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
19 ! Lesser General Public License for more details.
20 !
21 ! You should have received a copy of the GNU Lesser General Public License
22 ! along with this library; if not, write to the Free Software Foundation,
23 ! Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
24 !
25 
26 !
27 ! Release: This file is part of the kim-api-2.3.0 package.
28 !
29 
36  use, intrinsic :: iso_c_binding
37  implicit none
38  private
39 
40  public &
41  ! Derived types
42  kim_model_handle_type, &
43  ! Constants
45  ! Routines
46  operator(.eq.), &
47  operator(.ne.), &
50  kim_is_routine_present, &
51  kim_get_influence_distance, &
52  kim_get_number_of_neighbor_lists, &
53  kim_get_neighbor_list_values, &
54  kim_get_units, &
55  kim_compute_arguments_create, &
56  kim_compute_arguments_destroy, &
57  kim_compute, &
58  kim_extension, &
59  kim_clear_then_refresh, &
60  kim_write_parameterized_model, &
61  kim_get_species_support_and_code, &
62  kim_get_number_of_parameters, &
63  kim_get_parameter_metadata, &
64  kim_get_parameter, &
65  kim_set_parameter, &
66  kim_set_simulator_buffer_pointer, &
67  kim_get_simulator_buffer_pointer, &
68  kim_to_string, &
69  kim_set_log_id, &
70  kim_push_log_verbosity, &
71  kim_pop_log_verbosity
72 
78  type, bind(c) :: kim_model_handle_type
79  type(c_ptr) :: p = c_null_ptr
80  end type kim_model_handle_type
81 
85  type(kim_model_handle_type), protected, save &
87 
91  interface operator(.eq.)
92  module procedure kim_model_handle_equal
93  end interface operator(.eq.)
94 
98  interface operator(.ne.)
99  module procedure kim_model_handle_not_equal
100  end interface operator(.ne.)
101 
107  interface kim_is_routine_present
108  module procedure kim_model_is_routine_present
109  end interface kim_is_routine_present
110 
116  interface kim_get_influence_distance
117  module procedure kim_model_get_influence_distance
118  end interface kim_get_influence_distance
119 
125  interface kim_get_number_of_neighbor_lists
127  end interface kim_get_number_of_neighbor_lists
128 
134  interface kim_get_neighbor_list_values
135  module procedure kim_model_get_neighbor_list_values
136  end interface kim_get_neighbor_list_values
137 
143  interface kim_get_units
144  module procedure kim_model_get_units
145  end interface kim_get_units
146 
152  interface kim_compute_arguments_create
153  module procedure kim_model_compute_arguments_create
154  end interface kim_compute_arguments_create
155 
161  interface kim_compute_arguments_destroy
162  module procedure kim_model_compute_arguments_destroy
163  end interface kim_compute_arguments_destroy
164 
170  interface kim_compute
171  module procedure kim_model_compute
172  end interface kim_compute
173 
179  interface kim_extension
180  module procedure kim_model_extension
181  end interface kim_extension
182 
188  interface kim_clear_then_refresh
189  module procedure kim_model_clear_then_refresh
190  end interface kim_clear_then_refresh
191 
197  interface kim_write_parameterized_model
198  module procedure kim_model_write_parameterized_model
199  end interface kim_write_parameterized_model
200 
207  interface kim_get_species_support_and_code
209  end interface kim_get_species_support_and_code
210 
216  interface kim_get_number_of_parameters
217  module procedure kim_model_get_number_of_parameters
218  end interface kim_get_number_of_parameters
219 
225  interface kim_get_parameter_metadata
226  module procedure kim_model_get_parameter_metadata
227  end interface kim_get_parameter_metadata
228 
235  interface kim_get_parameter
236  module procedure kim_model_get_parameter_integer
237  module procedure kim_model_get_parameter_double
238  end interface kim_get_parameter
239 
246  interface kim_set_parameter
247  module procedure kim_model_set_parameter_integer
248  module procedure kim_model_set_parameter_double
249  end interface kim_set_parameter
250 
257  interface kim_set_simulator_buffer_pointer
259  end interface kim_set_simulator_buffer_pointer
260 
267  interface kim_get_simulator_buffer_pointer
269  end interface kim_get_simulator_buffer_pointer
270 
276  interface kim_to_string
277  module procedure kim_model_to_string
278  end interface kim_to_string
279 
285  interface kim_set_log_id
286  module procedure kim_model_set_log_id
287  end interface kim_set_log_id
288 
294  interface kim_push_log_verbosity
295  module procedure kim_model_push_log_verbosity
296  end interface kim_push_log_verbosity
297 
303  interface kim_pop_log_verbosity
304  module procedure kim_model_pop_log_verbosity
305  end interface kim_pop_log_verbosity
306 
307 contains
311  logical recursive function kim_model_handle_equal(lhs, rhs)
312  implicit none
313  type(kim_model_handle_type), intent(in) :: lhs
314  type(kim_model_handle_type), intent(in) :: rhs
315 
316  if ((.not. c_associated(lhs%p)) .and. (.not. c_associated(rhs%p))) then
317  kim_model_handle_equal = .true.
318  else
319  kim_model_handle_equal = c_associated(lhs%p, rhs%p)
320  end if
321  end function kim_model_handle_equal
322 
326  logical recursive function kim_model_handle_not_equal(lhs, rhs)
327  implicit none
328  type(kim_model_handle_type), intent(in) :: lhs
329  type(kim_model_handle_type), intent(in) :: rhs
330 
331  kim_model_handle_not_equal = .not. (lhs == rhs)
332  end function kim_model_handle_not_equal
333 
391  recursive subroutine kim_model_create( &
392  numbering, requested_length_unit, requested_energy_unit, &
393  requested_charge_unit, requested_temperature_unit, requested_time_unit, &
394  model_name, requested_units_accepted, model_handle, ierr)
395  use kim_numbering_module, only: kim_numbering_type
396  use kim_unit_system_module, only: kim_length_unit_type, &
397  kim_energy_unit_type, &
398  kim_charge_unit_type, &
399  kim_temperature_unit_type, &
400  kim_time_unit_type
401  implicit none
402  interface
403  integer(c_int) recursive function create( &
404  numbering, requested_length_unit, requested_energy_unit, &
405  requested_charge_unit, requested_temperature_unit, &
406  requested_time_unit, model_name, requested_units_accepted, model) &
407  bind(c, name="KIM_Model_Create")
408  use, intrinsic :: iso_c_binding
409  use kim_numbering_module, only: kim_numbering_type
410  use kim_unit_system_module, only: kim_length_unit_type, &
411  kim_energy_unit_type, &
412  kim_charge_unit_type, &
413  kim_temperature_unit_type, &
414  kim_time_unit_type
415  implicit none
416  type(kim_numbering_type), intent(in), value :: numbering
417  type(kim_length_unit_type), intent(in), value :: requested_length_unit
418  type(kim_energy_unit_type), intent(in), value :: requested_energy_unit
419  type(kim_charge_unit_type), intent(in), value :: requested_charge_unit
420  type(kim_temperature_unit_type), intent(in), value :: &
421  requested_temperature_unit
422  type(kim_time_unit_type), intent(in), value :: requested_time_unit
423  character(c_char), intent(in) :: model_name(*)
424  integer(c_int), intent(out) :: requested_units_accepted
425  type(c_ptr), intent(out) :: model
426  end function create
427  end interface
428  type(kim_numbering_type), intent(in) :: numbering
429  type(kim_length_unit_type), intent(in) :: requested_length_unit
430  type(kim_energy_unit_type), intent(in) :: requested_energy_unit
431  type(kim_charge_unit_type), intent(in) :: requested_charge_unit
432  type(kim_temperature_unit_type), intent(in) :: &
433  requested_temperature_unit
434  type(kim_time_unit_type), intent(in) :: requested_time_unit
435  character(len=*, kind=c_char), intent(in) :: model_name
436  integer(c_int), intent(out) :: requested_units_accepted
437  type(kim_model_handle_type), intent(out) :: model_handle
438  integer(c_int), intent(out) :: ierr
439 
440  type(c_ptr) :: pmodel
441 
442  ierr = create(numbering, requested_length_unit, requested_energy_unit, &
443  requested_charge_unit, requested_temperature_unit, &
444  requested_time_unit, trim(model_name)//c_null_char, &
445  requested_units_accepted, pmodel)
446  model_handle%p = pmodel
447  end subroutine kim_model_create
448 
470  recursive subroutine kim_model_destroy(model_handle)
471  implicit none
472  interface
473  recursive subroutine destroy(model) bind(c, name="KIM_Model_Destroy")
474  use, intrinsic :: iso_c_binding
475  implicit none
476  type(c_ptr), intent(inout) :: model
477  end subroutine destroy
478  end interface
479  type(kim_model_handle_type), intent(inout) :: model_handle
480 
481  type(c_ptr) :: pmodel
482  pmodel = model_handle%p
483  call destroy(pmodel)
484  model_handle%p = c_null_ptr
485  end subroutine kim_model_destroy
486 
492  recursive subroutine kim_model_is_routine_present( &
493  model_handle, model_routine_name, present, required, ierr)
494  use kim_interoperable_types_module, only: kim_model_type
495  use kim_model_routine_name_module, only: kim_model_routine_name_type
496  implicit none
497  interface
498  integer(c_int) recursive function is_routine_present( &
499  model, model_routine_name, present, required) &
500  bind(c, name="KIM_Model_IsRoutinePresent")
501  use, intrinsic :: iso_c_binding
502  use kim_interoperable_types_module, only: kim_model_type
503  use kim_model_routine_name_module, only: kim_model_routine_name_type
504  implicit none
505  type(kim_model_type), intent(in) :: model
506  type(kim_model_routine_name_type), intent(in), value &
507  :: model_routine_name
508  integer(c_int), intent(out) :: present
509  integer(c_int), intent(out) :: required
510  end function is_routine_present
511  end interface
512  type(kim_model_handle_type), intent(in) :: model_handle
513  type(kim_model_routine_name_type), intent(in) :: model_routine_name
514  integer(c_int), intent(out) :: present
515  integer(c_int), intent(out) :: required
516  integer(c_int), intent(out) :: ierr
517  type(kim_model_type), pointer :: model
518 
519  call c_f_pointer(model_handle%p, model)
520  ierr = is_routine_present(model, model_routine_name, present, required)
521  end subroutine kim_model_is_routine_present
522 
528  recursive subroutine kim_model_get_influence_distance( &
529  model_handle, influence_distance)
530  use kim_interoperable_types_module, only: kim_model_type
531  implicit none
532  interface
533  recursive subroutine get_influence_distance(model, influence_distance) &
534  bind(c, name="KIM_Model_GetInfluenceDistance")
535  use, intrinsic :: iso_c_binding
536  use kim_interoperable_types_module, only: kim_model_type
537  implicit none
538  type(kim_model_type), intent(in) :: model
539  real(c_double), intent(out) :: influence_distance
540  end subroutine get_influence_distance
541  end interface
542  type(kim_model_handle_type), intent(in) :: model_handle
543  real(c_double), intent(out) :: influence_distance
544  type(kim_model_type), pointer :: model
545 
546  call c_f_pointer(model_handle%p, model)
547  call get_influence_distance(model, influence_distance)
548  end subroutine kim_model_get_influence_distance
549 
555  recursive subroutine kim_model_get_number_of_neighbor_lists( &
556  model_handle, number_of_neighbor_lists)
557  use kim_interoperable_types_module, only: kim_model_type
558  implicit none
559  interface
560  recursive subroutine get_neighbor_list_pointers( &
561  model, number_of_neighbor_lists, cutoffs_ptr, &
562  model_will_not_request_neighbors_of_noncontributing__ptr) &
563  bind(c, name="KIM_Model_GetNeighborListPointers")
564  use, intrinsic :: iso_c_binding
565  use kim_interoperable_types_module, only: kim_model_type
566  implicit none
567  type(kim_model_type), intent(in) :: model
568  integer(c_int), intent(out) :: number_of_neighbor_lists
569  type(c_ptr), intent(out) :: cutoffs_ptr
570  type(c_ptr), intent(out) :: &
571  model_will_not_request_neighbors_of_noncontributing__ptr
572  end subroutine get_neighbor_list_pointers
573  end interface
574  type(kim_model_handle_type), intent(in) :: model_handle
575  integer(c_int), intent(out) :: number_of_neighbor_lists
576  type(kim_model_type), pointer :: model
577 
578  type(c_ptr) cutoffs_ptr, hint_ptr
579 
580  call c_f_pointer(model_handle%p, model)
581  call get_neighbor_list_pointers(model, number_of_neighbor_lists, &
582  cutoffs_ptr, hint_ptr)
584 
590  recursive subroutine kim_model_get_neighbor_list_values( &
591  model_handle, cutoffs, &
592  model_will_not_request_neighbors_of_noncontributing_particles, ierr)
593  use kim_interoperable_types_module, only: kim_model_type
594  implicit none
595  interface
596  recursive subroutine get_neighbor_list_pointers( &
597  model, number_of_neighbor_lists, cutoffs_ptr, &
598  model_will_not_request_neighbors_of_noncontributing__ptr) &
599  bind(c, name="KIM_Model_GetNeighborListPointers")
600  use, intrinsic :: iso_c_binding
601  use kim_interoperable_types_module, only: kim_model_type
602  implicit none
603  type(kim_model_type), intent(in) :: model
604  integer(c_int), intent(out) :: number_of_neighbor_lists
605  type(c_ptr), intent(out) :: cutoffs_ptr
606  type(c_ptr), intent(out) :: &
607  model_will_not_request_neighbors_of_noncontributing__ptr
608  end subroutine get_neighbor_list_pointers
609  end interface
610  type(kim_model_handle_type), intent(in) :: model_handle
611  real(c_double), intent(out) :: cutoffs(:)
612  integer(c_int), intent(out) :: &
613  model_will_not_request_neighbors_of_noncontributing_particles(:)
614  integer(c_int), intent(out) :: ierr
615  type(kim_model_type), pointer :: model
616 
617  integer(c_int) number_of_neighbor_lists
618  real(c_double), pointer :: cutoffs_fpointer(:)
619  integer(c_int), pointer :: &
620  model_will_not_request_neighbors_of_noncontributing__fpointer(:)
621  type(c_ptr) cutoffs_ptr
622  type(c_ptr) model_will_not_request_neighbors_of_noncontributing__ptr
623 
624  call c_f_pointer(model_handle%p, model)
625  call get_neighbor_list_pointers( &
626  model, number_of_neighbor_lists, cutoffs_ptr, &
627  model_will_not_request_neighbors_of_noncontributing__ptr)
628  if (c_associated(cutoffs_ptr)) then
629  call c_f_pointer(cutoffs_ptr, cutoffs_fpointer, &
630  [number_of_neighbor_lists])
631  else
632  nullify (cutoffs_fpointer)
633  end if
634  if (size(cutoffs) < number_of_neighbor_lists) then
635  ierr = 1
636  else
637  ierr = 0
638  cutoffs = cutoffs_fpointer(1:number_of_neighbor_lists)
639  end if
640 
641  if (c_associated( &
642  model_will_not_request_neighbors_of_noncontributing__ptr)) then
643  call c_f_pointer( &
644  model_will_not_request_neighbors_of_noncontributing__ptr, &
645  model_will_not_request_neighbors_of_noncontributing__fpointer, &
646  [number_of_neighbor_lists])
647  else
648  nullify ( &
649  model_will_not_request_neighbors_of_noncontributing__fpointer)
650  end if
651  if (size( &
652  model_will_not_request_neighbors_of_noncontributing_particles) &
653  < number_of_neighbor_lists) then
654  ierr = 1
655  else
656  ierr = 0
657  model_will_not_request_neighbors_of_noncontributing_particles = &
658  model_will_not_request_neighbors_of_noncontributing__fpointer( &
659  1:number_of_neighbor_lists)
660  end if
662 
668  recursive subroutine kim_model_get_units( &
669  model_handle, length_unit, energy_unit, charge_unit, temperature_unit, &
670  time_unit)
671  use kim_unit_system_module, only: kim_length_unit_type, &
672  kim_energy_unit_type, &
673  kim_charge_unit_type, &
674  kim_temperature_unit_type, &
675  kim_time_unit_type
676  use kim_interoperable_types_module, only: kim_model_type
677  implicit none
678  interface
679  recursive subroutine get_units( &
680  model, length_unit, energy_unit, charge_unit, temperature_unit, &
681  time_unit) &
682  bind(c, name="KIM_Model_GetUnits")
683  use, intrinsic :: iso_c_binding
684  use kim_unit_system_module, only: kim_length_unit_type, &
685  kim_energy_unit_type, &
686  kim_charge_unit_type, &
687  kim_temperature_unit_type, &
688  kim_time_unit_type
689  use kim_interoperable_types_module, only: kim_model_type
690  type(kim_model_type), intent(in) :: model
691  type(kim_length_unit_type), intent(out) :: length_unit
692  type(kim_energy_unit_type), intent(out) :: energy_unit
693  type(kim_charge_unit_type), intent(out) :: charge_unit
694  type(kim_temperature_unit_type), intent(out) :: temperature_unit
695  type(kim_time_unit_type), intent(out) :: time_unit
696  end subroutine get_units
697  end interface
698  type(kim_model_handle_type), intent(in) :: model_handle
699  type(kim_length_unit_type), intent(out) :: length_unit
700  type(kim_energy_unit_type), intent(out) :: energy_unit
701  type(kim_charge_unit_type), intent(out) :: charge_unit
702  type(kim_temperature_unit_type), intent(out) :: temperature_unit
703  type(kim_time_unit_type), intent(out) :: time_unit
704  type(kim_model_type), pointer :: model
705 
706  call c_f_pointer(model_handle%p, model)
707  call get_units(model, length_unit, energy_unit, charge_unit, &
708  temperature_unit, time_unit)
709  end subroutine kim_model_get_units
710 
737  recursive subroutine kim_model_compute_arguments_create( &
738  model_handle, compute_arguments_handle, ierr)
740  kim_compute_arguments_handle_type
741  use kim_interoperable_types_module, only: kim_model_type
742  implicit none
743  interface
744  integer(c_int) recursive function compute_arguments_create( &
745  model, compute_arguments) &
746  bind(c, name="KIM_Model_ComputeArgumentsCreate")
747  use, intrinsic :: iso_c_binding
748  use kim_interoperable_types_module, only: kim_model_type
749  implicit none
750  type(kim_model_type), intent(in) :: model
751  type(c_ptr), intent(out) :: compute_arguments
752  end function compute_arguments_create
753  end interface
754  type(kim_model_handle_type), intent(in) :: model_handle
755  type(kim_compute_arguments_handle_type), intent(out) :: &
756  compute_arguments_handle
757  integer(c_int), intent(out) :: ierr
758  type(kim_model_type), pointer :: model
759  type(c_ptr) :: pcompute_arguments
760 
761  call c_f_pointer(model_handle%p, model)
762 
763  ierr = compute_arguments_create(model, pcompute_arguments)
764  if (ierr == 0) then
765  compute_arguments_handle%p = pcompute_arguments
766  end if
768 
796  recursive subroutine kim_model_compute_arguments_destroy( &
797  model_handle, compute_arguments_handle, ierr)
798  use kim_compute_arguments_module, only: kim_compute_arguments_handle_type
799  use kim_interoperable_types_module, only: kim_model_type
800  implicit none
801  interface
802  integer(c_int) recursive function compute_arguments_destroy( &
803  model, compute_arguments) &
804  bind(c, name="KIM_Model_ComputeArgumentsDestroy")
805  use, intrinsic :: iso_c_binding
806  use kim_interoperable_types_module, only: kim_model_type
807  implicit none
808  type(kim_model_type), intent(in) :: model
809  type(c_ptr), intent(inout) :: compute_arguments
810  end function compute_arguments_destroy
811  end interface
812  type(kim_model_handle_type), intent(in) :: model_handle
813  type(kim_compute_arguments_handle_type), intent(inout) :: &
814  compute_arguments_handle
815  integer(c_int), intent(out) :: ierr
816  type(kim_model_type), pointer :: model
817  type(c_ptr) pcompute_arguments
818 
819  call c_f_pointer(model_handle%p, model)
820  pcompute_arguments = compute_arguments_handle%p
821  ierr = compute_arguments_destroy(model, pcompute_arguments)
822  if (ierr /= 0) then
823  compute_arguments_handle%p = c_null_ptr
824  end if
826 
852  recursive subroutine kim_model_compute( &
853  model_handle, compute_arguments_handle, ierr)
854  use kim_compute_arguments_module, only: kim_compute_arguments_handle_type
855  use kim_interoperable_types_module, only: kim_compute_arguments_type, &
856  kim_model_type
857  implicit none
858  interface
859  integer(c_int) recursive function compute(model, compute_arguments) &
860  bind(c, name="KIM_Model_Compute")
861  use, intrinsic :: iso_c_binding
862  use kim_interoperable_types_module, only: kim_compute_arguments_type
863  use kim_interoperable_types_module, only: kim_model_type
864  implicit none
865  type(kim_model_type), intent(in) :: model
866  type(kim_compute_arguments_type), intent(in) :: compute_arguments
867  end function compute
868  end interface
869  type(kim_model_handle_type), intent(in) :: model_handle
870  type(kim_compute_arguments_handle_type), intent(in) :: &
871  compute_arguments_handle
872  integer(c_int), intent(out) :: ierr
873  type(kim_model_type), pointer :: model
874  type(kim_compute_arguments_type), pointer :: compute_arguments
875 
876  call c_f_pointer(model_handle%p, model)
877  call c_f_pointer(compute_arguments_handle%p, compute_arguments)
878  ierr = compute(model, compute_arguments)
879  end subroutine kim_model_compute
880 
906  recursive subroutine kim_model_extension( &
907  model_handle, extension_id, extension_structure, ierr)
908  use kim_interoperable_types_module, only: kim_model_type
909  implicit none
910  interface
911  integer(c_int) recursive function extension( &
912  model, extension_id, extension_structure) &
913  bind(c, name="KIM_Model_Extension")
914  use, intrinsic :: iso_c_binding
915  use kim_interoperable_types_module, only: kim_model_type
916  implicit none
917  type(kim_model_type), intent(in) :: model
918  character(c_char), intent(in) :: extension_id(*)
919  type(c_ptr), intent(in), value :: extension_structure
920  end function extension
921  end interface
922  type(kim_model_handle_type), intent(in) :: model_handle
923  character(len=*, kind=c_char), intent(in) :: extension_id
924  type(c_ptr), intent(in) :: extension_structure
925  integer(c_int), intent(out) :: ierr
926  type(kim_model_type), pointer :: model
927 
928  call c_f_pointer(model_handle%p, model)
929  ierr = extension(model, trim(extension_id)//c_null_char, &
930  extension_structure)
931  end subroutine kim_model_extension
932 
954  recursive subroutine kim_model_clear_then_refresh(model_handle, ierr)
955  use kim_interoperable_types_module, only: kim_model_type
956  implicit none
957  interface
958  integer(c_int) recursive function clear_then_refresh(model) &
959  bind(c, name="KIM_Model_ClearThenRefresh")
960  use, intrinsic :: iso_c_binding
961  use kim_interoperable_types_module, only: kim_model_type
962  implicit none
963  type(kim_model_type), intent(in) :: model
964  end function clear_then_refresh
965  end interface
966  type(kim_model_handle_type), intent(in) :: model_handle
967  integer(c_int), intent(out) :: ierr
968  type(kim_model_type), pointer :: model
969 
970  call c_f_pointer(model_handle%p, model)
971  ierr = clear_then_refresh(model)
972  end subroutine kim_model_clear_then_refresh
973 
999  recursive subroutine kim_model_write_parameterized_model( &
1000  model_handle, path, model_name, ierr)
1001  use kim_interoperable_types_module, only: kim_model_type
1002  implicit none
1003  interface
1004  integer(c_int) recursive function write_parameterized_model( &
1005  model, path, model_name) &
1006  bind(c, name="KIM_Model_WriteParameterizedModel")
1007  use, intrinsic :: iso_c_binding
1008  use kim_interoperable_types_module, only: kim_model_type
1009  implicit none
1010  type(kim_model_type), intent(in) :: model
1011  character(c_char), intent(in) :: path(*)
1012  character(c_char), intent(in) :: model_name(*)
1013  end function write_parameterized_model
1014  end interface
1015  type(kim_model_handle_type), intent(in) :: model_handle
1016  character(len=*, kind=c_char), intent(in) :: path
1017  character(len=*, kind=c_char), intent(in) :: model_name
1018  integer(c_int), intent(out) :: ierr
1019  type(kim_model_type), pointer :: model
1020 
1021  call c_f_pointer(model_handle%p, model)
1022  ierr = write_parameterized_model(model, trim(path)//c_null_char, &
1023  trim(model_name)//c_null_char)
1025 
1032  recursive subroutine kim_model_get_species_support_and_code( &
1033  model_handle, species_name, species_is_supported, code, ierr)
1034  use kim_species_name_module, only: kim_species_name_type
1035  use kim_interoperable_types_module, only: kim_model_type
1036  implicit none
1037  interface
1038  integer(c_int) recursive function get_species_support_and_code( &
1039  model, species_name, species_is_supported, code) &
1040  bind(c, name="KIM_Model_GetSpeciesSupportAndCode")
1041  use, intrinsic :: iso_c_binding
1042  use kim_species_name_module, only: kim_species_name_type
1043  use kim_interoperable_types_module, only: kim_model_type
1044  implicit none
1045  type(kim_model_type), intent(in) :: model
1046  type(kim_species_name_type), intent(in), value :: species_name
1047  integer(c_int), intent(out) :: species_is_supported
1048  integer(c_int), intent(out) :: code
1049  end function get_species_support_and_code
1050  end interface
1051  type(kim_model_handle_type), intent(in) :: model_handle
1052  type(kim_species_name_type), intent(in) :: species_name
1053  integer(c_int), intent(out) :: species_is_supported
1054  integer(c_int), intent(out) :: code
1055  integer(c_int), intent(out) :: ierr
1056  type(kim_model_type), pointer :: model
1057 
1058  call c_f_pointer(model_handle%p, model)
1059  ierr = get_species_support_and_code(model, species_name, &
1060  species_is_supported, code)
1062 
1068  recursive subroutine kim_model_get_number_of_parameters( &
1069  model_handle, number_of_parameters)
1070  use kim_interoperable_types_module, only: kim_model_type
1071  implicit none
1072  interface
1073  recursive subroutine get_number_of_parameters( &
1074  model, number_of_parameters) &
1075  bind(c, name="KIM_Model_GetNumberOfParameters")
1076  use, intrinsic :: iso_c_binding
1077  use kim_interoperable_types_module, only: kim_model_type
1078  implicit none
1079  type(kim_model_type), intent(in) :: model
1080  integer(c_int), intent(out) :: number_of_parameters
1081  end subroutine get_number_of_parameters
1082  end interface
1083  type(kim_model_handle_type), intent(in) :: model_handle
1084  integer(c_int), intent(out) :: number_of_parameters
1085  type(kim_model_type), pointer :: model
1086 
1087  call c_f_pointer(model_handle%p, model)
1088  call get_number_of_parameters(model, number_of_parameters)
1089  end subroutine kim_model_get_number_of_parameters
1090 
1096  recursive subroutine kim_model_get_parameter_metadata( &
1097  model_handle, parameter_index, data_type, extent, name, description, ierr)
1098  use kim_data_type_module, only: kim_data_type_type
1099  use kim_convert_string_module, only: kim_convert_c_char_ptr_to_string
1100  use kim_interoperable_types_module, only: kim_model_type
1101  implicit none
1102  interface
1103  integer(c_int) recursive function get_parameter_metadata( &
1104  model, parameter_index, data_type, extent, name, description) &
1105  bind(c, name="KIM_Model_GetParameterMetadata")
1106  use, intrinsic :: iso_c_binding
1107  use kim_data_type_module, only: kim_data_type_type
1108  use kim_interoperable_types_module, only: kim_model_type
1109  implicit none
1110  type(kim_model_type), intent(in) :: model
1111  integer(c_int), intent(in), value :: parameter_index
1112  type(kim_data_type_type), intent(out) :: data_type
1113  integer(c_int), intent(out) :: extent
1114  type(c_ptr), intent(out) :: name
1115  type(c_ptr), intent(out) :: description
1116  end function get_parameter_metadata
1117  end interface
1118  type(kim_model_handle_type), intent(in) :: model_handle
1119  integer(c_int), intent(in) :: parameter_index
1120  type(kim_data_type_type), intent(out) :: data_type
1121  integer(c_int), intent(out) :: extent
1122  character(len=*, kind=c_char), intent(out) :: name
1123  character(len=*, kind=c_char), intent(out) :: description
1124  integer(c_int), intent(out) :: ierr
1125  type(kim_model_type), pointer :: model
1126 
1127  type(c_ptr) :: pname, pdesc
1128 
1129  call c_f_pointer(model_handle%p, model)
1130  ierr = get_parameter_metadata(model, parameter_index - 1, data_type, &
1131  extent, pname, pdesc)
1132  call kim_convert_c_char_ptr_to_string(pname, name)
1133  call kim_convert_c_char_ptr_to_string(pdesc, description)
1134  end subroutine kim_model_get_parameter_metadata
1135 
1141  recursive subroutine kim_model_get_parameter_integer( &
1142  model_handle, parameter_index, array_index, parameter_value, ierr)
1143  use kim_interoperable_types_module, only: kim_model_type
1144  implicit none
1145  interface
1146  integer(c_int) recursive function get_parameter_integer( &
1147  model, parameter_index, array_index, parameter_value) &
1148  bind(c, name="KIM_Model_GetParameterInteger")
1149  use, intrinsic :: iso_c_binding
1150  use kim_interoperable_types_module, only: kim_model_type
1151  implicit none
1152  type(kim_model_type), intent(in) :: model
1153  integer(c_int), intent(in), value :: parameter_index
1154  integer(c_int), intent(in), value :: array_index
1155  integer(c_int), intent(out) :: parameter_value
1156  end function get_parameter_integer
1157  end interface
1158  type(kim_model_handle_type), intent(in) :: model_handle
1159  integer(c_int), intent(in) :: parameter_index
1160  integer(c_int), intent(in) :: array_index
1161  integer(c_int), intent(out) :: parameter_value
1162  integer(c_int), intent(out) :: ierr
1163  type(kim_model_type), pointer :: model
1164 
1165  call c_f_pointer(model_handle%p, model)
1166  ierr = get_parameter_integer(model, parameter_index - 1, array_index - 1, &
1167  parameter_value)
1168  end subroutine kim_model_get_parameter_integer
1169 
1175  recursive subroutine kim_model_get_parameter_double( &
1176  model_handle, parameter_index, array_index, parameter_value, ierr)
1177  use kim_interoperable_types_module, only: kim_model_type
1178  implicit none
1179  interface
1180  integer(c_int) recursive function get_parameter_double( &
1181  model, parameter_index, array_index, parameter_value) &
1182  bind(c, name="KIM_Model_GetParameterDouble")
1183  use, intrinsic :: iso_c_binding
1184  use kim_interoperable_types_module, only: kim_model_type
1185  implicit none
1186  type(kim_model_type), intent(in) :: model
1187  integer(c_int), intent(in), value :: parameter_index
1188  integer(c_int), intent(in), value :: array_index
1189  real(c_double), intent(out) :: parameter_value
1190  end function get_parameter_double
1191  end interface
1192  type(kim_model_handle_type), intent(in) :: model_handle
1193  integer(c_int), intent(in) :: parameter_index
1194  integer(c_int), intent(in) :: array_index
1195  real(c_double), intent(out) :: parameter_value
1196  integer(c_int), intent(out) :: ierr
1197  type(kim_model_type), pointer :: model
1198 
1199  call c_f_pointer(model_handle%p, model)
1200  ierr = get_parameter_double(model, parameter_index - 1, array_index - 1, &
1201  parameter_value)
1202  end subroutine kim_model_get_parameter_double
1203 
1209  recursive subroutine kim_model_set_parameter_integer( &
1210  model_handle, parameter_index, array_index, parameter_value, ierr)
1211  use kim_interoperable_types_module, only: kim_model_type
1212  implicit none
1213  interface
1214  integer(c_int) recursive function set_parameter_integer( &
1215  model, parameter_index, array_index, parameter_value) &
1216  bind(c, name="KIM_Model_SetParameterInteger")
1217  use, intrinsic :: iso_c_binding
1218  use kim_interoperable_types_module, only: kim_model_type
1219  implicit none
1220  type(kim_model_type), intent(in) :: model
1221  integer(c_int), intent(in), value :: parameter_index
1222  integer(c_int), intent(in), value :: array_index
1223  integer(c_int), intent(in), value :: parameter_value
1224  end function set_parameter_integer
1225  end interface
1226  type(kim_model_handle_type), intent(in) :: model_handle
1227  integer(c_int), intent(in) :: parameter_index
1228  integer(c_int), intent(in) :: array_index
1229  integer(c_int), intent(in) :: parameter_value
1230  integer(c_int), intent(out) :: ierr
1231  type(kim_model_type), pointer :: model
1232 
1233  call c_f_pointer(model_handle%p, model)
1234  ierr = set_parameter_integer(model, parameter_index - 1, array_index - 1, &
1235  parameter_value)
1236  end subroutine kim_model_set_parameter_integer
1237 
1243  recursive subroutine kim_model_set_parameter_double( &
1244  model_handle, parameter_index, array_index, parameter_value, ierr)
1245  use kim_interoperable_types_module, only: kim_model_type
1246  implicit none
1247  interface
1248  integer(c_int) recursive function set_parameter_double( &
1249  model, parameter_index, array_index, parameter_value) &
1250  bind(c, name="KIM_Model_SetParameterDouble")
1251  use, intrinsic :: iso_c_binding
1252  use kim_interoperable_types_module, only: kim_model_type
1253  implicit none
1254  type(kim_model_type), intent(in) :: model
1255  integer(c_int), intent(in), value :: parameter_index
1256  integer(c_int), intent(in), value :: array_index
1257  real(c_double), intent(in), value :: parameter_value
1258  end function set_parameter_double
1259  end interface
1260  type(kim_model_handle_type), intent(in) :: model_handle
1261  integer(c_int), intent(in) :: parameter_index
1262  integer(c_int), intent(in) :: array_index
1263  real(c_double), intent(in) :: parameter_value
1264  integer(c_int), intent(out) :: ierr
1265  type(kim_model_type), pointer :: model
1266 
1267  call c_f_pointer(model_handle%p, model)
1268  ierr = set_parameter_double(model, parameter_index - 1, array_index - 1, &
1269  parameter_value)
1270  end subroutine kim_model_set_parameter_double
1271 
1278  recursive subroutine kim_model_set_simulator_buffer_pointer(model_handle, ptr)
1279  use kim_interoperable_types_module, only: kim_model_type
1280  implicit none
1281  interface
1282  recursive subroutine set_simulator_buffer_pointer(model, ptr) &
1283  bind(c, name="KIM_Model_SetSimulatorBufferPointer")
1284  use, intrinsic :: iso_c_binding
1285  use kim_interoperable_types_module, only: kim_model_type
1286  implicit none
1287  type(kim_model_type), intent(in) :: model
1288  type(c_ptr), intent(in), value :: ptr
1289  end subroutine set_simulator_buffer_pointer
1290  end interface
1291  type(kim_model_handle_type), intent(in) :: model_handle
1292  type(c_ptr), intent(in) :: ptr
1293  type(kim_model_type), pointer :: model
1294 
1295  call c_f_pointer(model_handle%p, model)
1296  call set_simulator_buffer_pointer(model, ptr)
1298 
1305  recursive subroutine kim_model_get_simulator_buffer_pointer(model_handle, ptr)
1306  use kim_interoperable_types_module, only: kim_model_type
1307  implicit none
1308  interface
1309  recursive subroutine get_simulator_buffer_pointer(model, ptr) &
1310  bind(c, name="KIM_Model_GetSimulatorBufferPointer")
1311  use, intrinsic :: iso_c_binding
1312  use kim_interoperable_types_module, only: kim_model_type
1313  implicit none
1314  type(kim_model_type), intent(in) :: model
1315  type(c_ptr), intent(out) :: ptr
1316  end subroutine get_simulator_buffer_pointer
1317  end interface
1318  type(kim_model_handle_type), intent(in) :: model_handle
1319  type(c_ptr), intent(out) :: ptr
1320  type(kim_model_type), pointer :: model
1321 
1322  call c_f_pointer(model_handle%p, model)
1323  call get_simulator_buffer_pointer(model, ptr)
1325 
1331  recursive subroutine kim_model_to_string(model_handle, string)
1332  use kim_convert_string_module, only: kim_convert_c_char_ptr_to_string
1333  use kim_interoperable_types_module, only: kim_model_type
1334  implicit none
1335  interface
1336  type(c_ptr) recursive function model_string(model) &
1337  bind(c, name="KIM_Model_ToString")
1338  use, intrinsic :: iso_c_binding
1339  use kim_interoperable_types_module, only: kim_model_type
1340  implicit none
1341  type(kim_model_type), intent(in) :: model
1342  end function model_string
1343  end interface
1344  type(kim_model_handle_type), intent(in) :: model_handle
1345  character(len=*, kind=c_char), intent(out) :: string
1346  type(kim_model_type), pointer :: model
1347 
1348  type(c_ptr) :: p
1349 
1350  call c_f_pointer(model_handle%p, model)
1351  p = model_string(model)
1352  call kim_convert_c_char_ptr_to_string(p, string)
1353  end subroutine kim_model_to_string
1354 
1360  recursive subroutine kim_model_set_log_id(model_handle, log_id)
1361  use kim_interoperable_types_module, only: kim_model_type
1362  implicit none
1363  interface
1364  recursive subroutine set_log_id(model, log_id) &
1365  bind(c, name="KIM_Model_SetLogID")
1366  use, intrinsic :: iso_c_binding
1367  use kim_interoperable_types_module, only: kim_model_type
1368  implicit none
1369  type(kim_model_type), intent(in) :: model
1370  character(c_char), intent(in) :: log_id(*)
1371  end subroutine set_log_id
1372  end interface
1373  type(kim_model_handle_type), intent(in) :: model_handle
1374  character(len=*, kind=c_char), intent(in) :: log_id
1375  type(kim_model_type), pointer :: model
1376 
1377  call c_f_pointer(model_handle%p, model)
1378  call set_log_id(model, trim(log_id)//c_null_char)
1379  end subroutine kim_model_set_log_id
1380 
1386  recursive subroutine kim_model_push_log_verbosity(model_handle, log_verbosity)
1387  use kim_log_verbosity_module, only: kim_log_verbosity_type
1388  use kim_interoperable_types_module, only: kim_model_type
1389  implicit none
1390  interface
1391  recursive subroutine push_log_verbosity(model, log_verbosity) &
1392  bind(c, name="KIM_Model_PushLogVerbosity")
1393  use, intrinsic :: iso_c_binding
1394  use kim_log_verbosity_module, only: kim_log_verbosity_type
1395  use kim_interoperable_types_module, only: kim_model_type
1396  implicit none
1397  type(kim_model_type), intent(in) :: model
1398  type(kim_log_verbosity_type), intent(in), value :: log_verbosity
1399  end subroutine push_log_verbosity
1400  end interface
1401  type(kim_model_handle_type), intent(in) :: model_handle
1402  type(kim_log_verbosity_type), intent(in) :: log_verbosity
1403  type(kim_model_type), pointer :: model
1404 
1405  call c_f_pointer(model_handle%p, model)
1406  call push_log_verbosity(model, log_verbosity)
1407  end subroutine kim_model_push_log_verbosity
1408 
1414  recursive subroutine kim_model_pop_log_verbosity(model_handle)
1415  use kim_log_verbosity_module, only: kim_log_verbosity_type
1416  use kim_interoperable_types_module, only: kim_model_type
1417  implicit none
1418  interface
1419  recursive subroutine pop_log_verbosity(model) &
1420  bind(c, name="KIM_Model_PopLogVerbosity")
1421  use, intrinsic :: iso_c_binding
1422  use kim_log_verbosity_module, only: kim_log_verbosity_type
1423  use kim_interoperable_types_module, only: kim_model_type
1424  implicit none
1425  type(kim_model_type), intent(in) :: model
1426  end subroutine pop_log_verbosity
1427  end interface
1428  type(kim_model_handle_type), intent(in) :: model_handle
1429  type(kim_model_type), pointer :: model
1430 
1431  call c_f_pointer(model_handle%p, model)
1432  call pop_log_verbosity(model)
1433  end subroutine kim_model_pop_log_verbosity
1434 end module kim_model_module
static int write_parameterized_model(KIM_ModelWriteParameterizedModel const *const modelWriteParameterizedModel)
recursive subroutine, public kim_model_destroy(model_handle)
Destroy a previously Model::Create&#39;d object.
recursive subroutine kim_model_get_influence_distance(model_handle, influence_distance)
Get the Model&#39;s influence distance.
recursive subroutine kim_model_to_string(model_handle, string)
Get a string representing the internal state of the Model object.
recursive subroutine kim_model_get_parameter_double(model_handle, parameter_index, array_index, parameter_value, ierr)
Get a parameter value from the Model.
static int compute_arguments_destroy(KIM_ModelCompute const *const modelCompute, KIM_ModelComputeArgumentsDestroy *const modelComputeArgumentsDestroy)
recursive subroutine kim_model_compute_arguments_create(model_handle, compute_arguments_handle, ierr)
Create a new ComputeArguments object for the Model object.
recursive subroutine kim_model_clear_then_refresh(model_handle, ierr)
Clear influence distance and neighbor list pointers and refresh Model object after parameter changes...
recursive subroutine kim_model_compute(model_handle, compute_arguments_handle, ierr)
Call the Model&#39;s MODEL_ROUTINE_NAME::Compute routine.
An Extensible Enumeration for the ModelRoutineName&#39;s supported by the KIM API.
recursive subroutine kim_model_get_neighbor_list_values(model_handle, cutoffs, model_will_not_request_neighbors_of_noncontributing_particles, ierr)
Get Model&#39;s neighbor list values.
recursive subroutine kim_model_set_log_id(model_handle, log_id)
Set the identity of the Log object associated with the Model object.
recursive subroutine kim_model_push_log_verbosity(model_handle, log_verbosity)
Push a new LogVerbosity onto the Model object&#39;s Log object verbosity stack.
recursive subroutine kim_model_write_parameterized_model(model_handle, path, model_name, ierr)
Call the Model&#39;s MODEL_ROUTINE_NAME::WriteParameterizedModel routine.
An Extensible Enumeration for the Numbering&#39;s supported by the KIM API.
recursive subroutine kim_model_set_parameter_double(model_handle, parameter_index, array_index, parameter_value, ierr)
Set a parameter value for the Model.
type(kim_model_handle_type), save, public, protected kim_model_null_handle
NULL handle for use in comparisons.
recursive subroutine kim_model_get_number_of_parameters(model_handle, number_of_parameters)
Get the number of parameter arrays provided by the Model.
recursive subroutine kim_model_get_parameter_metadata(model_handle, parameter_index, data_type, extent, name, description, ierr)
Get the metadata associated with one of the Model&#39;s parameter arrays.
recursive subroutine kim_model_get_number_of_neighbor_lists(model_handle, number_of_neighbor_lists)
Get Model&#39;s number of neighbor lists.
recursive subroutine kim_model_get_parameter_integer(model_handle, parameter_index, array_index, parameter_value, ierr)
Get a parameter value from the Model.
Provides the primary interface to a KIM API Model object and is meant to be used by simulators...
An Extensible Enumeration for the SpeciesName&#39;s supported by the KIM API.
recursive subroutine kim_model_get_simulator_buffer_pointer(model_handle, ptr)
Get the Simulator&#39;s buffer pointer from the Model object.
Provides the primary interface to a KIM API ComputeArguments object and is meant to be used by simula...
static int compute_arguments_create(KIM_ModelCompute const *const modelCompute, KIM_ModelComputeArgumentsCreate *const modelComputeArgumentsCreate)
recursive subroutine kim_model_set_parameter_integer(model_handle, parameter_index, array_index, parameter_value, ierr)
Set a parameter value for the Model.
recursive subroutine kim_model_set_simulator_buffer_pointer(model_handle, ptr)
Set the Simulator&#39;s buffer pointer within the Model object.
recursive subroutine kim_model_get_species_support_and_code(model_handle, species_name, species_is_supported, code, ierr)
Get the Model&#39;s support and code for the requested SpeciesName.
recursive subroutine, public kim_model_create(numbering, requested_length_unit, requested_energy_unit, requested_charge_unit, requested_temperature_unit, requested_time_unit, model_name, requested_units_accepted, model_handle, ierr)
Create a new KIM API Model object.
recursive subroutine kim_model_extension(model_handle, extension_id, extension_structure, ierr)
Call the Model&#39;s MODEL_ROUTINE_NAME::Extension routine.
An Extensible Enumeration for the DataType&#39;s supported by the KIM API.
recursive subroutine kim_model_pop_log_verbosity(model_handle)
Pop a LogVerbosity from the Model object&#39;s Log object verbosity stack.
An Extensible Enumeration for the LogVerbosity&#39;s supported by the KIM API.
recursive subroutine kim_model_get_units(model_handle, length_unit, energy_unit, charge_unit, temperature_unit, time_unit)
Get the Model&#39;s base unit values.
recursive subroutine kim_model_compute_arguments_destroy(model_handle, compute_arguments_handle, ierr)
Destroy a previously Model::ComputeArgumentsCreate&#39;d object.