kim-api  2.1.4-git+v2.1.3-git-3-g4c859c7f.GNU
An Application Programming Interface (API) for the Knowledgebase of Interatomic Models (KIM).
kim_model_extension_module.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) 2016--2019, Regents of the University of Minnesota.
23 ! All rights reserved.
24 !
25 ! Contributors:
26 ! Ryan S. Elliott
27 !
28 
29 !
30 ! Release: This file is part of the kim-api.git repository.
31 !
32 
33 
40  use, intrinsic :: iso_c_binding
41  implicit none
42  private
43 
44  public &
45  ! Derived types
46  kim_model_extension_handle_type, &
47 
48  ! Constants
50 
51  ! Routines
52  operator (.eq.), &
53  operator (.ne.), &
54  kim_get_extension_id, &
55  kim_to_model, &
56  kim_to_model_compute, &
57  kim_to_model_create, &
58  kim_to_model_destroy, &
59  kim_to_model_driver_create, &
60  kim_to_model_refresh, &
61  kim_to_model_write_parameterized_model, &
62  kim_to_model_compute_arguments, &
63  kim_to_model_compute_arguments_create, &
64  kim_to_model_compute_arguments_destroy, &
65  kim_c_char_array_to_string, &
66  kim_c_char_ptr_to_string, &
67  kim_string_to_c_char_array, &
68  kim_get_model_buffer_pointer, &
69  kim_log_entry, &
70  kim_to_string
71 
72 
78  type, bind(c) :: kim_model_extension_handle_type
79  type(c_ptr) :: p = c_null_ptr
80  end type kim_model_extension_handle_type
81 
85  type(kim_model_extension_handle_type), protected, save &
87 
91  interface operator (.eq.)
92  module procedure kim_model_extension_handle_equal
93  end interface operator (.eq.)
94 
98  interface operator (.ne.)
99  module procedure kim_model_extension_handle_not_equal
100  end interface operator (.ne.)
101 
107  interface kim_get_extension_id
108  module procedure kim_model_extension_get_extension_id
109  end interface kim_get_extension_id
110 
116  interface kim_to_model
117  module procedure kim_model_extension_to_model
118  end interface kim_to_model
119 
125  interface kim_to_model_compute
126  module procedure kim_model_extension_to_model_compute
127  end interface kim_to_model_compute
128 
134  interface kim_to_model_create
135  module procedure kim_model_extension_to_model_create
136  end interface kim_to_model_create
137 
143  interface kim_to_model_destroy
144  module procedure kim_model_extension_to_model_destroy
145  end interface kim_to_model_destroy
146 
153  interface kim_to_model_driver_create
155  end interface kim_to_model_driver_create
156 
162  interface kim_to_model_refresh
163  module procedure kim_model_extension_to_model_refresh
164  end interface kim_to_model_refresh
165 
172  interface kim_to_model_write_parameterized_model
174  end interface kim_to_model_write_parameterized_model
175 
182  interface kim_to_model_compute_arguments
184  end interface kim_to_model_compute_arguments
185 
192  interface kim_to_model_compute_arguments_create
194  end interface kim_to_model_compute_arguments_create
195 
202  interface kim_to_model_compute_arguments_destroy
204  end interface kim_to_model_compute_arguments_destroy
205 
209  interface kim_c_char_array_to_string
211  end interface kim_c_char_array_to_string
212 
216  interface kim_c_char_ptr_to_string
218  end interface kim_c_char_ptr_to_string
219 
223  interface kim_string_to_c_char_array
225  end interface kim_string_to_c_char_array
226 
233  interface kim_get_model_buffer_pointer
235  end interface kim_get_model_buffer_pointer
236 
242  interface kim_log_entry
243  module procedure kim_model_extension_log_entry
244  end interface kim_log_entry
245 
251  interface kim_to_string
252  module procedure kim_model_extension_to_string
253  end interface kim_to_string
254 
255 contains
259  logical recursive function kim_model_extension_handle_equal(lhs, rhs)
260  implicit none
261  type(kim_model_extension_handle_type), intent(in) :: lhs
262  type(kim_model_extension_handle_type), intent(in) :: rhs
263 
264  if ((.not. c_associated(lhs%p)) .and. (.not. c_associated(rhs%p))) then
265  kim_model_extension_handle_equal = .true.
266  else
267  kim_model_extension_handle_equal = c_associated(lhs%p, rhs%p)
268  end if
269  end function kim_model_extension_handle_equal
270 
274  logical recursive function kim_model_extension_handle_not_equal(lhs, rhs)
275  implicit none
276  type(kim_model_extension_handle_type), intent(in) :: lhs
277  type(kim_model_extension_handle_type), intent(in) :: rhs
278 
279  kim_model_extension_handle_not_equal = .not. (lhs .eq. rhs)
280  end function kim_model_extension_handle_not_equal
281 
287  recursive subroutine kim_model_extension_get_extension_id( &
288  model_extension_handle, extension_id)
289  use kim_convert_string_module, only : kim_convert_c_char_ptr_to_string
290  use kim_interoperable_types_module, only : kim_model_extension_type
291  implicit none
292  interface
293  recursive subroutine get_extension_id(model_extension, extension_id) &
294  bind(c, name="KIM_ModelExtension_GetExtensionID")
295  use, intrinsic :: iso_c_binding
296  use kim_interoperable_types_module, only : kim_model_extension_type
297  implicit none
298  type(kim_model_extension_type), intent(in) :: model_extension
299  type(c_ptr), intent(out) :: extension_id
300  end subroutine get_extension_id
301  end interface
302  type(kim_model_extension_handle_type), intent(in) :: model_extension_handle
303  character(len=*, kind=c_char), intent(out) :: extension_id
304  type(kim_model_extension_type), pointer :: model_extension
305 
306  type(c_ptr) :: p
307 
308  call c_f_pointer(model_extension_handle%p, model_extension)
309  call get_extension_id(model_extension, p)
310  call kim_convert_c_char_ptr_to_string(p, extension_id)
311  end subroutine kim_model_extension_get_extension_id
312 
318  recursive subroutine kim_model_extension_to_model(model_extension_handle, &
319  model_handle)
321  implicit none
322  type(kim_model_extension_handle_type), intent(in) :: model_extension_handle
323  type(kim_model_handle_type), intent(out) :: model_handle
324 
325  model_handle%p = model_extension_handle%p
326  end subroutine kim_model_extension_to_model
327 
333  recursive subroutine kim_model_extension_to_model_compute( &
334  model_extension_handle, model_compute_handle)
336  implicit none
337  type(kim_model_extension_handle_type), intent(in) :: model_extension_handle
338  type(kim_model_compute_handle_type), intent(out) :: model_compute_handle
339 
340  model_compute_handle%p = model_extension_handle%p
342 
348  recursive subroutine kim_model_extension_to_model_create( &
349  model_extension_handle, model_create_handle)
351  implicit none
352  type(kim_model_extension_handle_type), intent(in) :: model_extension_handle
353  type(kim_model_create_handle_type), intent(out) :: model_create_handle
354 
355  model_create_handle%p = model_extension_handle%p
357 
363  recursive subroutine kim_model_extension_to_model_destroy( &
364  model_extension_handle, model_destroy_handle)
366  implicit none
367  type(kim_model_extension_handle_type), intent(in) :: model_extension_handle
368  type(kim_model_destroy_handle_type), intent(out) :: model_destroy_handle
369 
370  model_destroy_handle%p = model_extension_handle%p
372 
379  recursive subroutine kim_model_extension_to_model_driver_create( &
380  model_extension_handle, model_driver_create_handle)
382  implicit none
383  type(kim_model_extension_handle_type), intent(in) :: model_extension_handle
384  type(kim_model_driver_create_handle_type), intent(out) &
385  :: model_driver_create_handle
386 
387  model_driver_create_handle%p = model_extension_handle%p
389 
395  recursive subroutine kim_model_extension_to_model_refresh( &
396  model_extension_handle, model_refresh_handle)
398  implicit none
399  type(kim_model_extension_handle_type), intent(in) :: model_extension_handle
400  type(kim_model_refresh_handle_type), intent(out) :: model_refresh_handle
401 
402  model_refresh_handle%p = model_extension_handle%p
404 
412  model_extension_handle, model_write_parameterized_model_handle)
414  implicit none
415  type(kim_model_extension_handle_type), intent(in) :: model_extension_handle
416  type(kim_model_write_parameterized_model_handle_type), intent(out) &
417  :: model_write_parameterized_model_handle
418 
419  model_write_parameterized_model_handle%p = model_extension_handle%p
421 
428  recursive subroutine kim_model_extension_to_model_compute_arguments( &
429  model_extension_handle, compute_arguments_c_ptr, &
430  model_compute_arguments_handle)
432  implicit none
433  type(kim_model_extension_handle_type), intent(in) :: model_extension_handle
434  type(c_ptr), intent(in) :: compute_arguments_c_ptr
435  type(kim_model_compute_arguments_handle_type), intent(out) &
436  :: model_compute_arguments_handle
437 
438  ! avoid unused dummy argument warnings
439  if (model_extension_handle .eq. kim_model_extension_null_handle) continue
440 
441  model_compute_arguments_handle%p = compute_arguments_c_ptr
443 
451  model_extension_handle, compute_arguments_c_ptr, &
452  model_compute_arguments_create_handle)
454  implicit none
455  type(kim_model_extension_handle_type), intent(in) :: model_extension_handle
456  type(c_ptr), intent(in) :: compute_arguments_c_ptr
457  type(kim_model_compute_arguments_create_handle_type), intent(out) &
458  :: model_compute_arguments_create_handle
459 
460  ! avoid unused dummy argument warnings
461  if (model_extension_handle .eq. kim_model_extension_null_handle) continue
462 
463  model_compute_arguments_create_handle%p = compute_arguments_c_ptr
465 
473  model_extension_handle, compute_arguments_c_ptr, &
474  model_compute_arguments_destroy_handle)
476  implicit none
477  type(kim_model_extension_handle_type), intent(in) :: model_extension_handle
478  type(c_ptr), intent(in) :: compute_arguments_c_ptr
479  type(kim_model_compute_arguments_destroy_handle_type), intent(out) &
480  :: model_compute_arguments_destroy_handle
481 
482  ! avoid unused dummy argument warnings
483  if (model_extension_handle .eq. kim_model_extension_null_handle) continue
484 
485  model_compute_arguments_destroy_handle%p = compute_arguments_c_ptr
487 
492  c_char_array, string)
493  use kim_convert_string_module, only : kim_convert_c_char_array_to_string
494  implicit none
495  character(len=1, kind=c_char), intent(in) :: c_char_array(:)
496  character(len=*, kind=c_char), intent(out) :: string
497 
498  call kim_convert_c_char_array_to_string(c_char_array, string)
500 
505  c_char_ptr, string)
506  use kim_convert_string_module, only : kim_convert_c_char_ptr_to_string
507  implicit none
508  type(c_ptr), intent(in) :: c_char_ptr
509  character(len=*, kind=c_char), intent(out) :: string
510 
511  call kim_convert_c_char_ptr_to_string(c_char_ptr, string)
513 
518  string, c_char_array)
519  use kim_convert_string_module, only : kim_convert_string_to_c_char_array
520  implicit none
521  character(len=*, kind=c_char), intent(in) :: string
522  character(len=1, kind=c_char), intent(out) :: c_char_array(:)
523 
524  call kim_convert_string_to_c_char_array(string, c_char_array)
526 
533  recursive subroutine kim_model_extension_get_model_buffer_pointer( &
534  model_extension_handle, ptr)
535  use kim_interoperable_types_module, only : kim_model_extension_type
536  implicit none
537  interface
538  recursive subroutine get_model_buffer_pointer(model_extension, ptr) &
539  bind(c, name="KIM_ModelExtension_GetModelBufferPointer")
540  use, intrinsic :: iso_c_binding
541  use kim_interoperable_types_module, only : kim_model_extension_type
542  implicit none
543  type(kim_model_extension_type), intent(in) :: model_extension
544  type(c_ptr), intent(out) :: ptr
545  end subroutine get_model_buffer_pointer
546  end interface
547  type(kim_model_extension_handle_type), intent(in) :: model_extension_handle
548  type(c_ptr), intent(out) :: ptr
549  type(kim_model_extension_type), pointer :: model_extension
550 
551  call c_f_pointer(model_extension_handle%p, model_extension)
552  call get_model_buffer_pointer(model_extension, ptr)
554 
560  recursive subroutine kim_model_extension_log_entry(model_extension_handle, &
561  log_verbosity, message)
562  use kim_log_verbosity_module, only : kim_log_verbosity_type
563  use kim_interoperable_types_module, only : kim_model_extension_type
564  implicit none
565  interface
566  recursive subroutine log_entry(model_extension, log_verbosity, message, &
567  line_number, file_name) bind(c, name="KIM_ModelExtension_LogEntry")
568  use, intrinsic :: iso_c_binding
569  use kim_log_verbosity_module, only : kim_log_verbosity_type
570  use kim_interoperable_types_module, only : kim_model_extension_type
571  implicit none
572  type(kim_model_extension_type), intent(in) :: model_extension
573  type(kim_log_verbosity_type), intent(in), value :: log_verbosity
574  character(c_char), intent(in) :: message(*)
575  integer(c_int), intent(in), value :: line_number
576  character(c_char), intent(in) :: file_name(*)
577  end subroutine log_entry
578  end interface
579  type(kim_model_extension_handle_type), intent(in) :: model_extension_handle
580  type(kim_log_verbosity_type), intent(in) :: log_verbosity
581  character(len=*, kind=c_char), intent(in) :: message
582  type(kim_model_extension_type), pointer :: model_extension
583 
584  call c_f_pointer(model_extension_handle%p, model_extension)
585  call log_entry(model_extension, log_verbosity, trim(message)//c_null_char, &
586  0, ""//c_null_char)
587  end subroutine kim_model_extension_log_entry
588 
594  recursive subroutine kim_model_extension_to_string(model_extension_handle, &
595  string)
596  use kim_convert_string_module, only : kim_convert_c_char_ptr_to_string
597  use kim_interoperable_types_module, only : kim_model_extension_type
598  implicit none
599  interface
600  type(c_ptr) recursive function model_extension_string(model_extension) &
601  bind(c, name="KIM_ModelExtension_ToString")
602  use, intrinsic :: iso_c_binding
603  use kim_interoperable_types_module, only : kim_model_extension_type
604  implicit none
605  type(kim_model_extension_type), intent(in) :: model_extension
606  end function model_extension_string
607  end interface
608  type(kim_model_extension_handle_type), intent(in) :: model_extension_handle
609  character(len=*, kind=c_char), intent(out) :: string
610  type(kim_model_extension_type), pointer :: model_extension
611 
612  type(c_ptr) :: p
613 
614  call c_f_pointer(model_extension_handle%p, model_extension)
615  p = model_extension_string(model_extension)
616  call kim_convert_c_char_ptr_to_string(p, string)
617  end subroutine kim_model_extension_to_string
recursive subroutine kim_model_extension_to_model_compute_arguments_destroy(model_extension_handle, compute_arguments_c_ptr, model_compute_arguments_destroy_handle)
Convert the ModelExtension interface to the Model object to a ModelComputeArgumentsDestroy interface...
Provides the interface to a KIM API Model object for use by models within their MODEL_ROUTINE_NAME::C...
recursive subroutine kim_model_extension_to_model_driver_create(model_extension_handle, model_driver_create_handle)
Convert the ModelExtension interface to the Model object to a ModelDriverCreate interface.
recursive subroutine kim_model_extension_to_model_create(model_extension_handle, model_create_handle)
Convert the ModelExtension interface to the Model object to a ModelCompute interface.
recursive subroutine kim_model_extension_convert_c_char_ptr_to_string(c_char_ptr, string)
Copy C character pointer to Fortran string.
Provides the interface to a KIM API ComputeArguments object for use by models within their MODEL_ROUT...
recursive subroutine kim_model_extension_to_model_refresh(model_extension_handle, model_refresh_handle)
Convert the ModelExtension interface to the Model object to a ModelRefresh interface.
Provides the interface to a KIM API Model object for use by models within their MODEL_ROUTINE_NAME::C...
Provides the interface to a KIM API Model object for use by models within their MODEL_ROUTINE_NAME::E...
Provides the interface to a KIM API Model object for use by models within their MODEL_ROUTINE_NAME::R...
Provides the interface to a KIM API Model object for use by models within their MODEL_ROUTINE_NAME::D...
recursive subroutine kim_model_extension_to_model(model_extension_handle, model_handle)
Convert the ModelExtension interface to the Model object to a Model interface.
recursive subroutine kim_model_extension_to_model_compute_arguments(model_extension_handle, compute_arguments_c_ptr, model_compute_arguments_handle)
Convert the ModelExtension interface to the Model object to a ModelComputeArguments interface...
Provides the interface to a KIM API Model object for use by models within their MODEL_ROUTINE_NAME::W...
recursive subroutine kim_model_extension_to_model_destroy(model_extension_handle, model_destroy_handle)
Convert the ModelExtension interface to the Model object to a ModelDestroy interface.
recursive subroutine kim_model_extension_log_entry(model_extension_handle, log_verbosity, message)
Write a log entry into the log file.
Provides the primary interface to a KIM API Model object and is meant to be used by simulators...
recursive subroutine kim_model_extension_to_model_compute(model_extension_handle, model_compute_handle)
Convert the ModelExtension interface to the Model object to a ModelCompute interface.
recursive subroutine kim_model_extension_to_model_write_parameterized_model(model_extension_handle, model_write_parameterized_model_handle)
Convert the ModelExtension interface to the Model object to a ModelWriteParameterizedModel interface...
recursive subroutine kim_model_extension_get_model_buffer_pointer(model_extension_handle, ptr)
Get the Model's buffer pointer within the Model object.
recursive subroutine kim_model_extension_to_model_compute_arguments_create(model_extension_handle, compute_arguments_c_ptr, model_compute_arguments_create_handle)
Convert the ModelExtension interface to the Model object to a ModelComputeArgumentsCreate interface...
Provides the interface to a KIM API ComputeArguments object for use by models within their MODEL_ROUT...
type(kim_model_extension_handle_type), save, public, protected kim_model_extension_null_handle
NULL handle for use in comparisons.
Provides the interface to a KIM API ComputeArguments object for use by models within their MODEL_ROUT...
recursive subroutine kim_model_extension_convert_c_char_array_to_string(c_char_array, string)
Copy C character array to Fortran string.
Provides the interface to a KIM API Model object for use by models within their MODEL_ROUTINE_NAME::C...
static int model_extension(KIM_ModelExtension *const modelExtension, void *const extensionStructure)
An Extensible Enumeration for the LogVerbosity's supported by the KIM API.
recursive subroutine kim_model_extension_convert_string_to_c_char_array(string, c_char_array)
Convert Fortran string to C character array.
recursive subroutine kim_model_extension_to_string(model_extension_handle, string)
Get a string representing the internal state of the Model object.