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_write_parameterized_model_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_write_parameterized_model_handle_type, &
47 
48  ! Constants
50 
51  ! Routines
52  operator (.eq.), &
53  operator (.ne.), &
54  kim_get_path, &
55  kim_get_model_name, &
56  kim_set_parameter_file_name, &
57  kim_get_model_buffer_pointer, &
58  kim_log_entry, &
59  kim_to_string
60 
61 
67  type, bind(c) :: kim_model_write_parameterized_model_handle_type
68  type(c_ptr) :: p = c_null_ptr
69  end type kim_model_write_parameterized_model_handle_type
70 
74  type(kim_model_write_parameterized_model_handle_type), protected, save &
76 
81  interface operator (.eq.)
82  module procedure kim_model_write_parameterized_model_handle_equal
83  end interface operator (.eq.)
84 
89  interface operator (.ne.)
90  module procedure kim_model_write_parameterized_model_handle_not_equal
91  end interface operator (.ne.)
92 
99  interface kim_get_path
100  module procedure kim_model_write_parameterized_model_get_path
101  end interface kim_get_path
102 
109  interface kim_get_model_name
111  end interface kim_get_model_name
112 
119  interface kim_set_parameter_file_name
121  end interface kim_set_parameter_file_name
122 
129  interface kim_get_model_buffer_pointer
130  module procedure &
132  end interface kim_get_model_buffer_pointer
133 
140  interface kim_log_entry
142  end interface kim_log_entry
143 
150  interface kim_to_string
152  end interface kim_to_string
153 
154 contains
159  logical recursive function kim_model_write_parameterized_model_handle_equal( &
160  lhs, rhs)
161  implicit none
162  type(kim_model_write_parameterized_model_handle_type), intent(in) :: lhs
163  type(kim_model_write_parameterized_model_handle_type), intent(in) :: rhs
164 
165  if ((.not. c_associated(lhs%p)) .and. (.not. c_associated(rhs%p))) then
166  kim_model_write_parameterized_model_handle_equal = .true.
167  else
168  kim_model_write_parameterized_model_handle_equal = &
169  c_associated(lhs%p, rhs%p)
170  end if
171  end function kim_model_write_parameterized_model_handle_equal
172 
177  logical recursive function &
178  kim_model_write_parameterized_model_handle_not_equal(lhs, rhs)
179  implicit none
180  type(kim_model_write_parameterized_model_handle_type), intent(in) :: lhs
181  type(kim_model_write_parameterized_model_handle_type), intent(in) :: rhs
182 
183  kim_model_write_parameterized_model_handle_not_equal = .not. (lhs .eq. rhs)
184  end function kim_model_write_parameterized_model_handle_not_equal
185 
192  recursive subroutine kim_model_write_parameterized_model_get_path( &
193  model_write_parameterized_model_handle, path)
194  use kim_convert_string_module, only : kim_convert_c_char_ptr_to_string
195  use kim_interoperable_types_module, only : &
196  kim_model_write_parameterized_model_type
197  implicit none
198  interface
199  recursive subroutine get_path(model_write_parameterized_model, path) &
200  bind(c, name="KIM_ModelWriteParameterizedModel_GetPath")
201  use, intrinsic :: iso_c_binding
202  use kim_interoperable_types_module, only : &
203  kim_model_write_parameterized_model_type
204  implicit none
205  type(kim_model_write_parameterized_model_type), intent(in) &
206  :: model_write_parameterized_model
207  type(c_ptr), intent(out) :: path
208  end subroutine get_path
209  end interface
210  type(kim_model_write_parameterized_model_handle_type), intent(in) &
211  :: model_write_parameterized_model_handle
212  character(len=*, kind=c_char), intent(out) :: path
213  type(kim_model_write_parameterized_model_type), pointer &
214  :: model_write_parameterized_model
215 
216  type(c_ptr) :: ppath
217 
218  call c_f_pointer(model_write_parameterized_model_handle%p, &
219  model_write_parameterized_model)
220  call get_path(model_write_parameterized_model, ppath)
221  call kim_convert_c_char_ptr_to_string(ppath, path)
222  end subroutine kim_model_write_parameterized_model_get_path
223 
231  model_write_parameterized_model_handle, model_name)
232  use kim_convert_string_module, only : kim_convert_c_char_ptr_to_string
233  use kim_interoperable_types_module, only : &
234  kim_model_write_parameterized_model_type
235  implicit none
236  interface
237  recursive subroutine get_model_name(model_write_parameterized_model, &
238  model_name) &
239  bind(c, name="KIM_ModelWriteParameterizedModel_GetModelName")
240  use, intrinsic :: iso_c_binding
241  use kim_interoperable_types_module, only : &
242  kim_model_write_parameterized_model_type
243  implicit none
244  type(kim_model_write_parameterized_model_type), intent(in) &
245  :: model_write_parameterized_model
246  type(c_ptr), intent(out) :: model_name
247  end subroutine get_model_name
248  end interface
249  type(kim_model_write_parameterized_model_handle_type), intent(in) &
250  :: model_write_parameterized_model_handle
251  character(len=*, kind=c_char), intent(out) :: model_name
252  type(kim_model_write_parameterized_model_type), pointer &
253  :: model_write_parameterized_model
254 
255  type(c_ptr) :: pmodel_name
256 
257  call c_f_pointer(model_write_parameterized_model_handle%p, &
258  model_write_parameterized_model)
259  call get_model_name(model_write_parameterized_model, pmodel_name)
260  call kim_convert_c_char_ptr_to_string(pmodel_name, model_name)
262 
269  recursive subroutine &
271  model_write_parameterized_model_handle, file_name)
272  use kim_interoperable_types_module, only : &
273  kim_model_write_parameterized_model_type
274  implicit none
275  interface
276  recursive subroutine set_parameter_file_name( &
277  model_write_parameterized_model, file_name) &
278  bind(c, name="KIM_ModelWriteParameterizedModel_SetParameterFileName")
279  use, intrinsic :: iso_c_binding
280  use kim_interoperable_types_module, only : &
281  kim_model_write_parameterized_model_type
282  implicit none
283  type(kim_model_write_parameterized_model_type), intent(in) &
284  :: model_write_parameterized_model
285  character(c_char), intent(in) :: file_name(*)
286  end subroutine set_parameter_file_name
287  end interface
288  type(kim_model_write_parameterized_model_handle_type), intent(in) &
289  :: model_write_parameterized_model_handle
290  character(len=*, kind=c_char), intent(in) :: file_name
291  type(kim_model_write_parameterized_model_type), pointer &
292  :: model_write_parameterized_model
293 
294  call c_f_pointer(model_write_parameterized_model_handle%p, &
295  model_write_parameterized_model)
296  call set_parameter_file_name(model_write_parameterized_model, &
297  trim(file_name)//c_null_char)
299 
306  recursive subroutine &
308  model_write_parameterized_model_handle, ptr)
309  use kim_interoperable_types_module, only : &
310  kim_model_write_parameterized_model_type
311  implicit none
312  interface
313  recursive subroutine get_model_buffer_pointer( &
314  model_write_parameterized_model, ptr) &
315  bind(c, name="KIM_ModelCompute_GetModelBufferPointer")
316  use, intrinsic :: iso_c_binding
317  use kim_interoperable_types_module, only : &
318  kim_model_write_parameterized_model_type
319  implicit none
320  type(kim_model_write_parameterized_model_type), intent(in) &
321  :: model_write_parameterized_model
322  type(c_ptr), intent(out) :: ptr
323  end subroutine get_model_buffer_pointer
324  end interface
325  type(kim_model_write_parameterized_model_handle_type), intent(in) &
326  :: model_write_parameterized_model_handle
327  type(c_ptr), intent(out) :: ptr
328  type(kim_model_write_parameterized_model_type), pointer &
329  :: model_write_parameterized_model
330 
331  call c_f_pointer(model_write_parameterized_model_handle%p, &
332  model_write_parameterized_model)
333  call get_model_buffer_pointer(model_write_parameterized_model, ptr)
335 
342  recursive subroutine kim_model_write_parameterized_model_log_entry( &
343  model_write_parameterized_model_handle, log_verbosity, message)
344  use kim_log_verbosity_module, only : kim_log_verbosity_type
345  use kim_interoperable_types_module, only : &
346  kim_model_write_parameterized_model_type
347  implicit none
348  interface
349  recursive subroutine log_entry(model_write_parameterized_model, &
350  log_verbosity, message, line_number, file_name) &
351  bind(c, name="KIM_ModelCompute_LogEntry")
352  use, intrinsic :: iso_c_binding
353  use kim_log_verbosity_module, only : kim_log_verbosity_type
354  use kim_interoperable_types_module, only : &
355  kim_model_write_parameterized_model_type
356  implicit none
357  type(kim_model_write_parameterized_model_type), intent(in) &
358  :: model_write_parameterized_model
359  type(kim_log_verbosity_type), intent(in), value :: log_verbosity
360  character(c_char), intent(in) :: message(*)
361  integer(c_int), intent(in), value :: line_number
362  character(c_char), intent(in) :: file_name(*)
363  end subroutine log_entry
364  end interface
365  type(kim_model_write_parameterized_model_handle_type), intent(in) &
366  :: model_write_parameterized_model_handle
367  type(kim_log_verbosity_type), intent(in) :: log_verbosity
368  character(len=*, kind=c_char), intent(in) :: message
369  type(kim_model_write_parameterized_model_type), pointer &
370  :: model_write_parameterized_model
371 
372  call c_f_pointer(model_write_parameterized_model_handle%p, &
373  model_write_parameterized_model)
374  call log_entry(model_write_parameterized_model, log_verbosity, &
375  trim(message)//c_null_char, 0, ""//c_null_char)
377 
384  recursive subroutine kim_model_write_parameterized_model_to_string( &
385  model_write_parameterized_model_handle, string)
386  use kim_convert_string_module, only : kim_convert_c_char_ptr_to_string
387  use kim_interoperable_types_module, only : &
388  kim_model_write_parameterized_model_type
389  implicit none
390  interface
391  type(c_ptr) recursive function model_write_parameterized_model_string( &
392  model_write_parameterized_model) &
393  bind(c, name="KIM_ModelCompute_ToString")
394  use, intrinsic :: iso_c_binding
395  use kim_interoperable_types_module, only : &
396  kim_model_write_parameterized_model_type
397  implicit none
398  type(kim_model_write_parameterized_model_type), intent(in) &
399  :: model_write_parameterized_model
400  end function model_write_parameterized_model_string
401  end interface
402  type(kim_model_write_parameterized_model_handle_type), intent(in) &
403  :: model_write_parameterized_model_handle
404  character(len=*, kind=c_char), intent(out) :: string
405  type(kim_model_write_parameterized_model_type), pointer &
406  :: model_write_parameterized_model
407 
408  type(c_ptr) :: p
409 
410  call c_f_pointer(model_write_parameterized_model_handle%p, &
411  model_write_parameterized_model)
412  p = model_write_parameterized_model_string(model_write_parameterized_model)
413  call kim_convert_c_char_ptr_to_string(p, string)
recursive subroutine kim_model_write_parameterized_model_get_model_buffer_pointer(model_write_parameterized_model_handle, ptr)
Get the Model's buffer pointer within the Model object.
recursive subroutine kim_model_write_parameterized_model_get_model_name(model_write_parameterized_model_handle, model_name)
Get the name of the new parameterized model.
recursive subroutine kim_model_write_parameterized_model_to_string(model_write_parameterized_model_handle, string)
Get a string representing the internal state of the Model object.
type(kim_model_write_parameterized_model_handle_type), save, public, protected kim_model_write_parameterized_model_null_handle
NULL handle for use in comparisons.
Provides the interface to a KIM API Model object for use by models within their MODEL_ROUTINE_NAME::W...
recursive subroutine kim_model_write_parameterized_model_set_parameter_file_name(model_write_parameterized_model_handle, file_name)
Set the file name for the next parameter file.
An Extensible Enumeration for the LogVerbosity's supported by the KIM API.
recursive subroutine kim_model_write_parameterized_model_log_entry(model_write_parameterized_model_handle, log_verbosity, message)
Write a log entry into the log file.