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_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_compute_handle_type, &
47 
48  ! Constants
50 
51  ! Routines
52  operator (.eq.), &
53  operator (.ne.), &
54  kim_get_model_buffer_pointer, &
55  kim_log_entry, &
56  kim_to_string
57 
58 
64  type, bind(c) :: kim_model_compute_handle_type
65  type(c_ptr) :: p = c_null_ptr
66  end type kim_model_compute_handle_type
67 
71  type(kim_model_compute_handle_type), protected, save &
73 
77  interface operator (.eq.)
78  module procedure kim_model_compute_handle_equal
79  end interface operator (.eq.)
80 
84  interface operator (.ne.)
85  module procedure kim_model_compute_handle_not_equal
86  end interface operator (.ne.)
87 
94  interface kim_get_model_buffer_pointer
95  module procedure kim_model_compute_get_model_buffer_pointer
96  end interface kim_get_model_buffer_pointer
97 
103  interface kim_log_entry
104  module procedure kim_model_compute_log_entry
105  end interface kim_log_entry
106 
112  interface kim_to_string
113  module procedure kim_model_compute_to_string
114  end interface kim_to_string
115 
116 contains
120  logical recursive function kim_model_compute_handle_equal(lhs, rhs)
121  implicit none
122  type(kim_model_compute_handle_type), intent(in) :: lhs
123  type(kim_model_compute_handle_type), intent(in) :: rhs
124 
125  if ((.not. c_associated(lhs%p)) .and. (.not. c_associated(rhs%p))) then
126  kim_model_compute_handle_equal = .true.
127  else
128  kim_model_compute_handle_equal = c_associated(lhs%p, rhs%p)
129  end if
130  end function kim_model_compute_handle_equal
131 
135  logical recursive function kim_model_compute_handle_not_equal(lhs, rhs)
136  implicit none
137  type(kim_model_compute_handle_type), intent(in) :: lhs
138  type(kim_model_compute_handle_type), intent(in) :: rhs
139 
140  kim_model_compute_handle_not_equal = .not. (lhs .eq. rhs)
141  end function kim_model_compute_handle_not_equal
142 
149  recursive subroutine kim_model_compute_get_model_buffer_pointer( &
150  model_compute_handle, ptr)
151  use kim_interoperable_types_module, only : kim_model_compute_type
152  implicit none
153  interface
154  recursive subroutine get_model_buffer_pointer(model_compute, ptr) &
155  bind(c, name="KIM_ModelCompute_GetModelBufferPointer")
156  use, intrinsic :: iso_c_binding
157  use kim_interoperable_types_module, only : kim_model_compute_type
158  implicit none
159  type(kim_model_compute_type), intent(in) :: model_compute
160  type(c_ptr), intent(out) :: ptr
161  end subroutine get_model_buffer_pointer
162  end interface
163  type(kim_model_compute_handle_type), intent(in) :: model_compute_handle
164  type(c_ptr), intent(out) :: ptr
165  type(kim_model_compute_type), pointer :: model_compute
166 
167  call c_f_pointer(model_compute_handle%p, model_compute)
168  call get_model_buffer_pointer(model_compute, ptr)
169  end subroutine kim_model_compute_get_model_buffer_pointer
170 
176  recursive subroutine kim_model_compute_log_entry(model_compute_handle, &
177  log_verbosity, message)
178  use kim_log_verbosity_module, only : kim_log_verbosity_type
179  use kim_interoperable_types_module, only : kim_model_compute_type
180  implicit none
181  interface
182  recursive subroutine log_entry(model_compute, log_verbosity, message, &
183  line_number, file_name) bind(c, name="KIM_ModelCompute_LogEntry")
184  use, intrinsic :: iso_c_binding
185  use kim_log_verbosity_module, only : kim_log_verbosity_type
186  use kim_interoperable_types_module, only : kim_model_compute_type
187  implicit none
188  type(kim_model_compute_type), intent(in) :: model_compute
189  type(kim_log_verbosity_type), intent(in), value :: log_verbosity
190  character(c_char), intent(in) :: message(*)
191  integer(c_int), intent(in), value :: line_number
192  character(c_char), intent(in) :: file_name(*)
193  end subroutine log_entry
194  end interface
195  type(kim_model_compute_handle_type), intent(in) :: model_compute_handle
196  type(kim_log_verbosity_type), intent(in) :: log_verbosity
197  character(len=*, kind=c_char), intent(in) :: message
198  type(kim_model_compute_type), pointer :: model_compute
199 
200  call c_f_pointer(model_compute_handle%p, model_compute)
201  call log_entry(model_compute, log_verbosity, trim(message)//c_null_char, &
202  0, ""//c_null_char)
203  end subroutine kim_model_compute_log_entry
204 
210  recursive subroutine kim_model_compute_to_string(model_compute_handle, string)
211  use kim_convert_string_module, only : kim_convert_c_char_ptr_to_string
212  use kim_interoperable_types_module, only : kim_model_compute_type
213  implicit none
214  interface
215  type(c_ptr) recursive function model_compute_string(model_compute) &
216  bind(c, name="KIM_ModelCompute_ToString")
217  use, intrinsic :: iso_c_binding
218  use kim_interoperable_types_module, only : kim_model_compute_type
219  implicit none
220  type(kim_model_compute_type), intent(in) :: model_compute
221  end function model_compute_string
222  end interface
223  type(kim_model_compute_handle_type), intent(in) :: model_compute_handle
224  character(len=*, kind=c_char), intent(out) :: string
225  type(kim_model_compute_type), pointer :: model_compute
226 
227  type(c_ptr) :: p
228 
229  call c_f_pointer(model_compute_handle%p, model_compute)
230  p = model_compute_string(model_compute)
231  call kim_convert_c_char_ptr_to_string(p, string)
232  end subroutine kim_model_compute_to_string
233 end module kim_model_compute_module
type(kim_model_compute_handle_type), save, public, protected kim_model_compute_null_handle
NULL handle for use in comparisons.
static int model_compute(KIM_ModelCompute const *const modelCompute, KIM_ModelComputeArguments const *const modelComputeArguments)
recursive subroutine kim_model_compute_to_string(model_compute_handle, string)
Get a string representing the internal state of the Model object.
recursive subroutine kim_model_compute_log_entry(model_compute_handle, log_verbosity, message)
Write a log entry into the log file.
Provides the interface to a KIM API Model object for use by models within their MODEL_ROUTINE_NAME::C...
An Extensible Enumeration for the LogVerbosity's supported by the KIM API.