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_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--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 
41  use, intrinsic :: iso_c_binding
42  implicit none
43  private
44 
45  public &
46  ! Derived types
47  kim_model_compute_arguments_create_handle_type, &
48 
49  ! Constants
51 
52  ! Routines
53  operator (.eq.), &
54  operator (.ne.), &
55  kim_set_argument_support_status, &
56  kim_set_callback_support_status, &
57  kim_set_model_buffer_pointer, &
58  kim_log_entry, &
59  kim_to_string
60 
61 
68  type, bind(c) :: kim_model_compute_arguments_create_handle_type
69  type(c_ptr) :: p = c_null_ptr
70  end type kim_model_compute_arguments_create_handle_type
71 
75  type(kim_model_compute_arguments_create_handle_type), protected, save &
77 
82  interface operator (.eq.)
83  module procedure kim_model_compute_arguments_create_handle_equal
84  end interface operator (.eq.)
85 
90  interface operator (.ne.)
91  module procedure kim_model_compute_arguments_create_handle_not_equal
92  end interface operator (.ne.)
93 
101  interface kim_set_argument_support_status
102  module procedure &
103  kim_model_compute_arguments_create_set_argument_support_status
104  end interface kim_set_argument_support_status
105 
113  interface kim_set_callback_support_status
114  module procedure &
116  end interface kim_set_callback_support_status
117 
124  interface kim_set_model_buffer_pointer
126  end interface kim_set_model_buffer_pointer
127 
134  interface kim_log_entry
136  end interface kim_log_entry
137 
144  interface kim_to_string
146  end interface kim_to_string
147 
148 contains
153  logical recursive function kim_model_compute_arguments_create_handle_equal( &
154  lhs, rhs)
155  implicit none
156  type(kim_model_compute_arguments_create_handle_type), intent(in) :: lhs
157  type(kim_model_compute_arguments_create_handle_type), intent(in) :: rhs
158 
159  if ((.not. c_associated(lhs%p)) .and. (.not. c_associated(rhs%p))) then
160  kim_model_compute_arguments_create_handle_equal = .true.
161  else
162  kim_model_compute_arguments_create_handle_equal = c_associated(lhs%p, &
163  rhs%p)
164  end if
165  end function kim_model_compute_arguments_create_handle_equal
166 
171  logical recursive function &
172  kim_model_compute_arguments_create_handle_not_equal(lhs, rhs)
173  implicit none
174  type(kim_model_compute_arguments_create_handle_type), intent(in) :: lhs
175  type(kim_model_compute_arguments_create_handle_type), intent(in) :: rhs
176 
177  kim_model_compute_arguments_create_handle_not_equal = &
178  .not. (lhs .eq. rhs)
179  end function kim_model_compute_arguments_create_handle_not_equal
180 
188  recursive subroutine &
189  kim_model_compute_arguments_create_set_argument_support_status( &
190  model_commpute_arguments_create_handle, compute_argument_name, &
191  support_status, ierr)
192  use kim_compute_argument_name_module, only : kim_compute_argument_name_type
193  use kim_support_status_module, only : kim_support_status_type
194  use kim_interoperable_types_module, only : &
195  kim_model_compute_arguments_create_type
196  implicit none
197  interface
198  integer(c_int) recursive function set_argument_support_status( &
199  model_commpute_arguments_create, compute_argument_name, &
200  support_status) &
201  bind(c, name="KIM_ModelComputeArgumentsCreate_SetArgumentSupportStatus")
202  use, intrinsic :: iso_c_binding
204  kim_compute_argument_name_type
205  use kim_support_status_module, only : kim_support_status_type
206  use kim_interoperable_types_module, only : &
207  kim_model_compute_arguments_create_type
208  implicit none
209  type(kim_model_compute_arguments_create_type), intent(in) :: &
210  model_commpute_arguments_create
211  type(kim_compute_argument_name_type), intent(in), value :: &
212  compute_argument_name
213  type(kim_support_status_type), intent(in), value :: support_status
214  end function set_argument_support_status
215  end interface
216  type(kim_model_compute_arguments_create_handle_type), intent(in) :: &
217  model_commpute_arguments_create_handle
218  type(kim_compute_argument_name_type), intent(in) :: &
219  compute_argument_name
220  type(kim_support_status_type), intent(in) :: support_status
221  integer(c_int), intent(out) :: ierr
222  type(kim_model_compute_arguments_create_type), pointer :: &
223  model_commpute_arguments_create
224 
225  call c_f_pointer(model_commpute_arguments_create_handle%p, &
226  model_commpute_arguments_create)
227  ierr = set_argument_support_status(model_commpute_arguments_create, &
228  compute_argument_name, support_status)
229  end subroutine kim_model_compute_arguments_create_set_argument_support_status
230 
238  recursive subroutine &
240  model_commpute_arguments_create_handle, compute_callback_name, &
241  support_status, ierr)
242  use kim_compute_callback_name_module, only : kim_compute_callback_name_type
243  use kim_support_status_module, only : kim_support_status_type
244  use kim_interoperable_types_module, only : &
245  kim_model_compute_arguments_create_type
246  implicit none
247  interface
248  integer(c_int) recursive function set_callback_support_status( &
249  model_commpute_arguments_create, compute_callback_name, &
250  support_status) &
251  bind(c, name="KIM_ModelComputeArgumentsCreate_SetCallbackSupportStatus")
252  use, intrinsic :: iso_c_binding
254  kim_compute_callback_name_type
255  use kim_support_status_module, only : kim_support_status_type
256  use kim_interoperable_types_module, only : &
257  kim_model_compute_arguments_create_type
258  implicit none
259  type(kim_model_compute_arguments_create_type), intent(in) :: &
260  model_commpute_arguments_create
261  type(kim_compute_callback_name_type), intent(in), value :: &
262  compute_callback_name
263  type(kim_support_status_type), intent(in), value :: support_status
264  end function set_callback_support_status
265  end interface
266  type(kim_model_compute_arguments_create_handle_type), intent(in) :: &
267  model_commpute_arguments_create_handle
268  type(kim_compute_callback_name_type), intent(in) :: &
269  compute_callback_name
270  type(kim_support_status_type), intent(in) :: support_status
271  integer(c_int), intent(out) :: ierr
272  type(kim_model_compute_arguments_create_type), pointer :: &
273  model_commpute_arguments_create
274 
275  call c_f_pointer(model_commpute_arguments_create_handle%p, &
276  model_commpute_arguments_create)
277  ierr = set_callback_support_status(model_commpute_arguments_create, &
278  compute_callback_name, support_status)
280 
287  recursive subroutine &
289  model_commpute_arguments_create_handle, ptr)
290  use kim_interoperable_types_module, only : &
291  kim_model_compute_arguments_create_type
292  implicit none
293  interface
294  recursive subroutine set_model_buffer_pointer( &
295  model_commpute_arguments_create, ptr) bind(c, &
296  name="KIM_ModelComputeArgumentsCreate_SetModelBufferPointer")
297  use, intrinsic :: iso_c_binding
298  use kim_interoperable_types_module, only : &
299  kim_model_compute_arguments_create_type
300  implicit none
301  type(kim_model_compute_arguments_create_type), intent(in) :: &
302  model_commpute_arguments_create
303  type(c_ptr), intent(in), value :: ptr
304  end subroutine set_model_buffer_pointer
305  end interface
306  type(kim_model_compute_arguments_create_handle_type), intent(in) :: &
307  model_commpute_arguments_create_handle
308  type(c_ptr), intent(in) :: ptr
309  type(kim_model_compute_arguments_create_type), pointer :: &
310  model_commpute_arguments_create
311 
312  call c_f_pointer(model_commpute_arguments_create_handle%p, &
313  model_commpute_arguments_create)
314  call set_model_buffer_pointer(model_commpute_arguments_create, ptr)
316 
323  recursive subroutine kim_model_compute_arguments_create_log_entry( &
324  model_commpute_arguments_create_handle, log_verbosity, message)
325  use kim_log_verbosity_module, only : kim_log_verbosity_type
326  use kim_interoperable_types_module, only : &
327  kim_model_compute_arguments_create_type
328  implicit none
329  interface
330  recursive subroutine log_entry(model_commpute_arguments_create, &
331  log_verbosity, message, line_number, file_name) &
332  bind(c, name="KIM_ModelComputeArgumentsCreate_LogEntry")
333  use, intrinsic :: iso_c_binding
334  use kim_log_verbosity_module, only : kim_log_verbosity_type
335  use kim_interoperable_types_module, only : &
336  kim_model_compute_arguments_create_type
337  implicit none
338  type(kim_model_compute_arguments_create_type), intent(in) :: &
339  model_commpute_arguments_create
340  type(kim_log_verbosity_type), intent(in), value :: log_verbosity
341  character(c_char), intent(in) :: message(*)
342  integer(c_int), intent(in), value :: line_number
343  character(c_char), intent(in) :: file_name(*)
344  end subroutine log_entry
345  end interface
346  type(kim_model_compute_arguments_create_handle_type), intent(in) :: &
347  model_commpute_arguments_create_handle
348  type(kim_log_verbosity_type), intent(in) :: log_verbosity
349  character(len=*, kind=c_char), intent(in) :: message
350  type(kim_model_compute_arguments_create_type), pointer :: &
351  model_commpute_arguments_create
352 
353  call c_f_pointer(model_commpute_arguments_create_handle%p, &
354  model_commpute_arguments_create)
355  call log_entry(model_commpute_arguments_create, log_verbosity, &
356  trim(message)//c_null_char, 0, ""//c_null_char)
358 
365  recursive subroutine kim_model_compute_arguments_create_to_string( &
366  model_commpute_arguments_create_handle, string)
367  use kim_convert_string_module, only : kim_convert_c_char_ptr_to_string
368  use kim_interoperable_types_module, only : &
369  kim_model_compute_arguments_create_type
370  implicit none
371  interface
372  type(c_ptr) recursive function model_commpute_arguments_create_string( &
373  model_commpute_arguments_create) &
374  bind(c, name="KIM_ModelComputeArgumentsCreate_ToString")
375  use, intrinsic :: iso_c_binding
376  use kim_interoperable_types_module, only : &
377  kim_model_compute_arguments_create_type
378  implicit none
379  type(kim_model_compute_arguments_create_type), intent(in) :: &
380  model_commpute_arguments_create
381  end function model_commpute_arguments_create_string
382  end interface
383  type(kim_model_compute_arguments_create_handle_type), intent(in) :: &
384  model_commpute_arguments_create_handle
385  character(len=*, kind=c_char), intent(out) :: string
386  type(kim_model_compute_arguments_create_type), pointer :: &
387  model_commpute_arguments_create
388 
389  type(c_ptr) :: p
390 
391  call c_f_pointer(model_commpute_arguments_create_handle%p, &
392  model_commpute_arguments_create)
393  p = model_commpute_arguments_create_string(model_commpute_arguments_create)
394  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.