kim-api  2.3.0+v2.3.0.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 ! 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 
37  use, intrinsic :: iso_c_binding
38  implicit none
39  private
40 
41  public &
42  ! Derived types
43  kim_model_compute_arguments_create_handle_type, &
44  ! Constants
46  ! Routines
47  operator(.eq.), &
48  operator(.ne.), &
49  kim_set_argument_support_status, &
50  kim_set_callback_support_status, &
51  kim_set_model_buffer_pointer, &
52  kim_log_entry, &
53  kim_to_string
54 
61  type, bind(c) :: kim_model_compute_arguments_create_handle_type
62  type(c_ptr) :: p = c_null_ptr
63  end type kim_model_compute_arguments_create_handle_type
64 
68  type(kim_model_compute_arguments_create_handle_type), protected, save &
70 
75  interface operator(.eq.)
76  module procedure kim_model_compute_arguments_create_handle_equal
77  end interface operator(.eq.)
78 
83  interface operator(.ne.)
84  module procedure kim_model_compute_arguments_create_handle_not_equal
85  end interface operator(.ne.)
86 
94  interface kim_set_argument_support_status
95  module procedure &
96  kim_model_compute_arguments_create_set_argument_support_status
97  end interface kim_set_argument_support_status
98 
106  interface kim_set_callback_support_status
107  module procedure &
109  end interface kim_set_callback_support_status
110 
117  interface kim_set_model_buffer_pointer
119  end interface kim_set_model_buffer_pointer
120 
127  interface kim_log_entry
129  end interface kim_log_entry
130 
137  interface kim_to_string
139  end interface kim_to_string
140 
141 contains
146  logical recursive function kim_model_compute_arguments_create_handle_equal( &
147  lhs, rhs)
148  implicit none
149  type(kim_model_compute_arguments_create_handle_type), intent(in) :: lhs
150  type(kim_model_compute_arguments_create_handle_type), intent(in) :: rhs
151 
152  if ((.not. c_associated(lhs%p)) .and. (.not. c_associated(rhs%p))) then
153  kim_model_compute_arguments_create_handle_equal = .true.
154  else
155  kim_model_compute_arguments_create_handle_equal = c_associated(lhs%p, &
156  rhs%p)
157  end if
158  end function kim_model_compute_arguments_create_handle_equal
159 
164  logical recursive function &
165  kim_model_compute_arguments_create_handle_not_equal(lhs, rhs)
166  implicit none
167  type(kim_model_compute_arguments_create_handle_type), intent(in) :: lhs
168  type(kim_model_compute_arguments_create_handle_type), intent(in) :: rhs
169 
170  kim_model_compute_arguments_create_handle_not_equal = &
171  .not. (lhs == rhs)
172  end function kim_model_compute_arguments_create_handle_not_equal
173 
181  recursive subroutine &
182  kim_model_compute_arguments_create_set_argument_support_status( &
183  model_commpute_arguments_create_handle, compute_argument_name, &
184  support_status, ierr)
185  use kim_compute_argument_name_module, only: kim_compute_argument_name_type
186  use kim_support_status_module, only: kim_support_status_type
187  use kim_interoperable_types_module, only: &
188  kim_model_compute_arguments_create_type
189  implicit none
190  interface
191  integer(c_int) recursive function set_argument_support_status( &
192  model_commpute_arguments_create, compute_argument_name, &
193  support_status) &
194  bind(c, name="KIM_ModelComputeArgumentsCreate_SetArgumentSupportStatus")
195  use, intrinsic :: iso_c_binding
197  kim_compute_argument_name_type
198  use kim_support_status_module, only: kim_support_status_type
199  use kim_interoperable_types_module, only: &
200  kim_model_compute_arguments_create_type
201  implicit none
202  type(kim_model_compute_arguments_create_type), intent(in) :: &
203  model_commpute_arguments_create
204  type(kim_compute_argument_name_type), intent(in), value :: &
205  compute_argument_name
206  type(kim_support_status_type), intent(in), value :: support_status
207  end function set_argument_support_status
208  end interface
209  type(kim_model_compute_arguments_create_handle_type), intent(in) :: &
210  model_commpute_arguments_create_handle
211  type(kim_compute_argument_name_type), intent(in) :: &
212  compute_argument_name
213  type(kim_support_status_type), intent(in) :: support_status
214  integer(c_int), intent(out) :: ierr
215  type(kim_model_compute_arguments_create_type), pointer :: &
216  model_commpute_arguments_create
217 
218  call c_f_pointer(model_commpute_arguments_create_handle%p, &
219  model_commpute_arguments_create)
220  ierr = set_argument_support_status(model_commpute_arguments_create, &
221  compute_argument_name, support_status)
222  end subroutine kim_model_compute_arguments_create_set_argument_support_status
223 
231  recursive subroutine &
233  model_commpute_arguments_create_handle, compute_callback_name, &
234  support_status, ierr)
235  use kim_compute_callback_name_module, only: kim_compute_callback_name_type
236  use kim_support_status_module, only: kim_support_status_type
237  use kim_interoperable_types_module, only: &
238  kim_model_compute_arguments_create_type
239  implicit none
240  interface
241  integer(c_int) recursive function set_callback_support_status( &
242  model_commpute_arguments_create, compute_callback_name, &
243  support_status) &
244  bind(c, name="KIM_ModelComputeArgumentsCreate_SetCallbackSupportStatus")
245  use, intrinsic :: iso_c_binding
247  kim_compute_callback_name_type
248  use kim_support_status_module, only: kim_support_status_type
249  use kim_interoperable_types_module, only: &
250  kim_model_compute_arguments_create_type
251  implicit none
252  type(kim_model_compute_arguments_create_type), intent(in) :: &
253  model_commpute_arguments_create
254  type(kim_compute_callback_name_type), intent(in), value :: &
255  compute_callback_name
256  type(kim_support_status_type), intent(in), value :: support_status
257  end function set_callback_support_status
258  end interface
259  type(kim_model_compute_arguments_create_handle_type), intent(in) :: &
260  model_commpute_arguments_create_handle
261  type(kim_compute_callback_name_type), intent(in) :: &
262  compute_callback_name
263  type(kim_support_status_type), intent(in) :: support_status
264  integer(c_int), intent(out) :: ierr
265  type(kim_model_compute_arguments_create_type), pointer :: &
266  model_commpute_arguments_create
267 
268  call c_f_pointer(model_commpute_arguments_create_handle%p, &
269  model_commpute_arguments_create)
270  ierr = set_callback_support_status(model_commpute_arguments_create, &
271  compute_callback_name, support_status)
273 
280  recursive subroutine &
282  model_commpute_arguments_create_handle, ptr)
283  use kim_interoperable_types_module, only: &
284  kim_model_compute_arguments_create_type
285  implicit none
286  interface
287  recursive subroutine set_model_buffer_pointer( &
288  model_commpute_arguments_create, ptr) &
289  bind(c, name="KIM_ModelComputeArgumentsCreate_SetModelBufferPointer")
290  use, intrinsic :: iso_c_binding
291  use kim_interoperable_types_module, only: &
292  kim_model_compute_arguments_create_type
293  implicit none
294  type(kim_model_compute_arguments_create_type), intent(in) :: &
295  model_commpute_arguments_create
296  type(c_ptr), intent(in), value :: ptr
297  end subroutine set_model_buffer_pointer
298  end interface
299  type(kim_model_compute_arguments_create_handle_type), intent(in) :: &
300  model_commpute_arguments_create_handle
301  type(c_ptr), intent(in) :: ptr
302  type(kim_model_compute_arguments_create_type), pointer :: &
303  model_commpute_arguments_create
304 
305  call c_f_pointer(model_commpute_arguments_create_handle%p, &
306  model_commpute_arguments_create)
307  call set_model_buffer_pointer(model_commpute_arguments_create, ptr)
309 
316  recursive subroutine kim_model_compute_arguments_create_log_entry( &
317  model_commpute_arguments_create_handle, log_verbosity, message)
318  use kim_log_verbosity_module, only: kim_log_verbosity_type
319  use kim_interoperable_types_module, only: &
320  kim_model_compute_arguments_create_type
321  implicit none
322  interface
323  recursive subroutine log_entry( &
324  model_commpute_arguments_create, log_verbosity, message, line_number, &
325  file_name) bind(c, name="KIM_ModelComputeArgumentsCreate_LogEntry")
326  use, intrinsic :: iso_c_binding
327  use kim_log_verbosity_module, only: kim_log_verbosity_type
328  use kim_interoperable_types_module, only: &
329  kim_model_compute_arguments_create_type
330  implicit none
331  type(kim_model_compute_arguments_create_type), intent(in) :: &
332  model_commpute_arguments_create
333  type(kim_log_verbosity_type), intent(in), value :: log_verbosity
334  character(c_char), intent(in) :: message(*)
335  integer(c_int), intent(in), value :: line_number
336  character(c_char), intent(in) :: file_name(*)
337  end subroutine log_entry
338  end interface
339  type(kim_model_compute_arguments_create_handle_type), intent(in) :: &
340  model_commpute_arguments_create_handle
341  type(kim_log_verbosity_type), intent(in) :: log_verbosity
342  character(len=*, kind=c_char), intent(in) :: message
343  type(kim_model_compute_arguments_create_type), pointer :: &
344  model_commpute_arguments_create
345 
346  call c_f_pointer(model_commpute_arguments_create_handle%p, &
347  model_commpute_arguments_create)
348  call log_entry(model_commpute_arguments_create, log_verbosity, &
349  trim(message)//c_null_char, 0, ""//c_null_char)
351 
358  recursive subroutine kim_model_compute_arguments_create_to_string( &
359  model_commpute_arguments_create_handle, string)
360  use kim_convert_string_module, only: kim_convert_c_char_ptr_to_string
361  use kim_interoperable_types_module, only: &
362  kim_model_compute_arguments_create_type
363  implicit none
364  interface
365  type(c_ptr) recursive function model_commpute_arguments_create_string( &
366  model_commpute_arguments_create) &
367  bind(c, name="KIM_ModelComputeArgumentsCreate_ToString")
368  use, intrinsic :: iso_c_binding
369  use kim_interoperable_types_module, only: &
370  kim_model_compute_arguments_create_type
371  implicit none
372  type(kim_model_compute_arguments_create_type), intent(in) :: &
373  model_commpute_arguments_create
374  end function model_commpute_arguments_create_string
375  end interface
376  type(kim_model_compute_arguments_create_handle_type), intent(in) :: &
377  model_commpute_arguments_create_handle
378  character(len=*, kind=c_char), intent(out) :: string
379  type(kim_model_compute_arguments_create_type), pointer :: &
380  model_commpute_arguments_create
381 
382  type(c_ptr) :: p
383 
384  call c_f_pointer(model_commpute_arguments_create_handle%p, &
385  model_commpute_arguments_create)
386  p = model_commpute_arguments_create_string(model_commpute_arguments_create)
387  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.