kim-api  2.2.1+v2.2.1.GNU.GNU.
An Application Programming Interface (API) for the Knowledgebase of Interatomic Models (KIM).
kim_model_compute_arguments_create_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--2020, 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-2.2.1 package.
31 !
32 
40  use, intrinsic :: iso_c_binding
41  implicit none
42  private
43 
44  public &
45  ! Derived types
46  kim_model_compute_arguments_create_handle_type, &
47  ! Constants
49  ! Routines
50  operator(.eq.), &
51  operator(.ne.), &
52  kim_set_argument_support_status, &
53  kim_set_callback_support_status, &
54  kim_set_model_buffer_pointer, &
55  kim_log_entry, &
56  kim_to_string
57 
64  type, bind(c) :: kim_model_compute_arguments_create_handle_type
65  type(c_ptr) :: p = c_null_ptr
66  end type kim_model_compute_arguments_create_handle_type
67 
71  type(kim_model_compute_arguments_create_handle_type), protected, save &
73 
78  interface operator(.eq.)
79  module procedure kim_model_compute_arguments_create_handle_equal
80  end interface operator(.eq.)
81 
86  interface operator(.ne.)
87  module procedure kim_model_compute_arguments_create_handle_not_equal
88  end interface operator(.ne.)
89 
97  interface kim_set_argument_support_status
98  module procedure &
99  kim_model_compute_arguments_create_set_argument_support_status
100  end interface kim_set_argument_support_status
101 
109  interface kim_set_callback_support_status
110  module procedure &
112  end interface kim_set_callback_support_status
113 
120  interface kim_set_model_buffer_pointer
122  end interface kim_set_model_buffer_pointer
123 
130  interface kim_log_entry
132  end interface kim_log_entry
133 
140  interface kim_to_string
142  end interface kim_to_string
143 
144 contains
149  logical recursive function kim_model_compute_arguments_create_handle_equal( &
150  lhs, rhs)
151  implicit none
152  type(kim_model_compute_arguments_create_handle_type), intent(in) :: lhs
153  type(kim_model_compute_arguments_create_handle_type), intent(in) :: rhs
154 
155  if ((.not. c_associated(lhs%p)) .and. (.not. c_associated(rhs%p))) then
156  kim_model_compute_arguments_create_handle_equal = .true.
157  else
158  kim_model_compute_arguments_create_handle_equal = c_associated(lhs%p, &
159  rhs%p)
160  end if
161  end function kim_model_compute_arguments_create_handle_equal
162 
167  logical recursive function &
168  kim_model_compute_arguments_create_handle_not_equal(lhs, rhs)
169  implicit none
170  type(kim_model_compute_arguments_create_handle_type), intent(in) :: lhs
171  type(kim_model_compute_arguments_create_handle_type), intent(in) :: rhs
172 
173  kim_model_compute_arguments_create_handle_not_equal = &
174  .not. (lhs == rhs)
175  end function kim_model_compute_arguments_create_handle_not_equal
176 
184  recursive subroutine &
185  kim_model_compute_arguments_create_set_argument_support_status( &
186  model_commpute_arguments_create_handle, compute_argument_name, &
187  support_status, ierr)
188  use kim_compute_argument_name_module, only: kim_compute_argument_name_type
189  use kim_support_status_module, only: kim_support_status_type
190  use kim_interoperable_types_module, only: &
191  kim_model_compute_arguments_create_type
192  implicit none
193  interface
194  integer(c_int) recursive function set_argument_support_status( &
195  model_commpute_arguments_create, compute_argument_name, &
196  support_status) &
197  bind(c, name="KIM_ModelComputeArgumentsCreate_SetArgumentSupportStatus")
198  use, intrinsic :: iso_c_binding
200  kim_compute_argument_name_type
201  use kim_support_status_module, only: kim_support_status_type
202  use kim_interoperable_types_module, only: &
203  kim_model_compute_arguments_create_type
204  implicit none
205  type(kim_model_compute_arguments_create_type), intent(in) :: &
206  model_commpute_arguments_create
207  type(kim_compute_argument_name_type), intent(in), value :: &
208  compute_argument_name
209  type(kim_support_status_type), intent(in), value :: support_status
210  end function set_argument_support_status
211  end interface
212  type(kim_model_compute_arguments_create_handle_type), intent(in) :: &
213  model_commpute_arguments_create_handle
214  type(kim_compute_argument_name_type), intent(in) :: &
215  compute_argument_name
216  type(kim_support_status_type), intent(in) :: support_status
217  integer(c_int), intent(out) :: ierr
218  type(kim_model_compute_arguments_create_type), pointer :: &
219  model_commpute_arguments_create
220 
221  call c_f_pointer(model_commpute_arguments_create_handle%p, &
222  model_commpute_arguments_create)
223  ierr = set_argument_support_status(model_commpute_arguments_create, &
224  compute_argument_name, support_status)
225  end subroutine kim_model_compute_arguments_create_set_argument_support_status
226 
234  recursive subroutine &
236  model_commpute_arguments_create_handle, compute_callback_name, &
237  support_status, ierr)
238  use kim_compute_callback_name_module, only: kim_compute_callback_name_type
239  use kim_support_status_module, only: kim_support_status_type
240  use kim_interoperable_types_module, only: &
241  kim_model_compute_arguments_create_type
242  implicit none
243  interface
244  integer(c_int) recursive function set_callback_support_status( &
245  model_commpute_arguments_create, compute_callback_name, &
246  support_status) &
247  bind(c, name="KIM_ModelComputeArgumentsCreate_SetCallbackSupportStatus")
248  use, intrinsic :: iso_c_binding
250  kim_compute_callback_name_type
251  use kim_support_status_module, only: kim_support_status_type
252  use kim_interoperable_types_module, only: &
253  kim_model_compute_arguments_create_type
254  implicit none
255  type(kim_model_compute_arguments_create_type), intent(in) :: &
256  model_commpute_arguments_create
257  type(kim_compute_callback_name_type), intent(in), value :: &
258  compute_callback_name
259  type(kim_support_status_type), intent(in), value :: support_status
260  end function set_callback_support_status
261  end interface
262  type(kim_model_compute_arguments_create_handle_type), intent(in) :: &
263  model_commpute_arguments_create_handle
264  type(kim_compute_callback_name_type), intent(in) :: &
265  compute_callback_name
266  type(kim_support_status_type), intent(in) :: support_status
267  integer(c_int), intent(out) :: ierr
268  type(kim_model_compute_arguments_create_type), pointer :: &
269  model_commpute_arguments_create
270 
271  call c_f_pointer(model_commpute_arguments_create_handle%p, &
272  model_commpute_arguments_create)
273  ierr = set_callback_support_status(model_commpute_arguments_create, &
274  compute_callback_name, support_status)
276 
283  recursive subroutine &
285  model_commpute_arguments_create_handle, ptr)
286  use kim_interoperable_types_module, only: &
287  kim_model_compute_arguments_create_type
288  implicit none
289  interface
290  recursive subroutine set_model_buffer_pointer( &
291  model_commpute_arguments_create, ptr) &
292  bind(c, name="KIM_ModelComputeArgumentsCreate_SetModelBufferPointer")
293  use, intrinsic :: iso_c_binding
294  use kim_interoperable_types_module, only: &
295  kim_model_compute_arguments_create_type
296  implicit none
297  type(kim_model_compute_arguments_create_type), intent(in) :: &
298  model_commpute_arguments_create
299  type(c_ptr), intent(in), value :: ptr
300  end subroutine set_model_buffer_pointer
301  end interface
302  type(kim_model_compute_arguments_create_handle_type), intent(in) :: &
303  model_commpute_arguments_create_handle
304  type(c_ptr), intent(in) :: ptr
305  type(kim_model_compute_arguments_create_type), pointer :: &
306  model_commpute_arguments_create
307 
308  call c_f_pointer(model_commpute_arguments_create_handle%p, &
309  model_commpute_arguments_create)
310  call set_model_buffer_pointer(model_commpute_arguments_create, ptr)
312 
319  recursive subroutine kim_model_compute_arguments_create_log_entry( &
320  model_commpute_arguments_create_handle, log_verbosity, message)
321  use kim_log_verbosity_module, only: kim_log_verbosity_type
322  use kim_interoperable_types_module, only: &
323  kim_model_compute_arguments_create_type
324  implicit none
325  interface
326  recursive subroutine log_entry( &
327  model_commpute_arguments_create, log_verbosity, message, line_number, &
328  file_name) bind(c, name="KIM_ModelComputeArgumentsCreate_LogEntry")
329  use, intrinsic :: iso_c_binding
330  use kim_log_verbosity_module, only: kim_log_verbosity_type
331  use kim_interoperable_types_module, only: &
332  kim_model_compute_arguments_create_type
333  implicit none
334  type(kim_model_compute_arguments_create_type), intent(in) :: &
335  model_commpute_arguments_create
336  type(kim_log_verbosity_type), intent(in), value :: log_verbosity
337  character(c_char), intent(in) :: message(*)
338  integer(c_int), intent(in), value :: line_number
339  character(c_char), intent(in) :: file_name(*)
340  end subroutine log_entry
341  end interface
342  type(kim_model_compute_arguments_create_handle_type), intent(in) :: &
343  model_commpute_arguments_create_handle
344  type(kim_log_verbosity_type), intent(in) :: log_verbosity
345  character(len=*, kind=c_char), intent(in) :: message
346  type(kim_model_compute_arguments_create_type), pointer :: &
347  model_commpute_arguments_create
348 
349  call c_f_pointer(model_commpute_arguments_create_handle%p, &
350  model_commpute_arguments_create)
351  call log_entry(model_commpute_arguments_create, log_verbosity, &
352  trim(message)//c_null_char, 0, ""//c_null_char)
354 
361  recursive subroutine kim_model_compute_arguments_create_to_string( &
362  model_commpute_arguments_create_handle, string)
363  use kim_convert_string_module, only: kim_convert_c_char_ptr_to_string
364  use kim_interoperable_types_module, only: &
365  kim_model_compute_arguments_create_type
366  implicit none
367  interface
368  type(c_ptr) recursive function model_commpute_arguments_create_string( &
369  model_commpute_arguments_create) &
370  bind(c, name="KIM_ModelComputeArgumentsCreate_ToString")
371  use, intrinsic :: iso_c_binding
372  use kim_interoperable_types_module, only: &
373  kim_model_compute_arguments_create_type
374  implicit none
375  type(kim_model_compute_arguments_create_type), intent(in) :: &
376  model_commpute_arguments_create
377  end function model_commpute_arguments_create_string
378  end interface
379  type(kim_model_compute_arguments_create_handle_type), intent(in) :: &
380  model_commpute_arguments_create_handle
381  character(len=*, kind=c_char), intent(out) :: string
382  type(kim_model_compute_arguments_create_type), pointer :: &
383  model_commpute_arguments_create
384 
385  type(c_ptr) :: p
386 
387  call c_f_pointer(model_commpute_arguments_create_handle%p, &
388  model_commpute_arguments_create)
389  p = model_commpute_arguments_create_string(model_commpute_arguments_create)
390  call kim_convert_c_char_ptr_to_string(p, string)
type(kim_model_compute_arguments_create_handle_type), save, public, protected kim_model_compute_arguments_create_null_handle
NULL handle for use in comparisons.
recursive subroutine kim_model_compute_arguments_create_to_string(model_commpute_arguments_create_handle, string)
Get a string representing the internal state of the ComputeArguments object.
Provides the interface to a KIM API ComputeArguments object for use by models within their MODEL_ROUT...
recursive subroutine kim_model_compute_arguments_create_set_callback_support_status(model_commpute_arguments_create_handle, compute_callback_name, support_status, ierr)
Set the SupportStatus of a ComputeCallbackName.
An Extensible Enumeration for the SupportStatus's supported by the KIM API.
An Extensible Enumeration for the ComputeCallbackName's supported by the KIM API. ...
recursive subroutine kim_model_compute_arguments_create_set_model_buffer_pointer(model_commpute_arguments_create_handle, ptr)
Set the Model's buffer pointer within the ComputeArguments object.
An Extensible Enumeration for the ComputeArgumentName's supported by the KIM API. ...
recursive subroutine kim_model_compute_arguments_create_log_entry(model_commpute_arguments_create_handle, log_verbosity, message)
Write a log entry into the log file.
An Extensible Enumeration for the LogVerbosity's supported by the KIM API.