kim-api  2.3.0+v2.3.0.GNU.GNU.
An Application Programming Interface (API) for the Knowledgebase of Interatomic Models (KIM).
kim_model_destroy_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 
36  use, intrinsic :: iso_c_binding
37  implicit none
38  private
39 
40  public &
41  ! Destroy types
42  kim_model_destroy_handle_type, &
43  ! Constants
45  ! Routines
46  operator(.eq.), &
47  operator(.ne.), &
48  kim_get_model_buffer_pointer, &
49  kim_log_entry, &
50  kim_to_string
51 
57  type, bind(c) :: kim_model_destroy_handle_type
58  type(c_ptr) :: p = c_null_ptr
59  end type kim_model_destroy_handle_type
60 
64  type(kim_model_destroy_handle_type), protected, save &
66 
70  interface operator(.eq.)
71  module procedure kim_model_destroy_handle_equal
72  end interface operator(.eq.)
73 
77  interface operator(.ne.)
78  module procedure kim_model_destroy_handle_not_equal
79  end interface operator(.ne.)
80 
87  interface kim_get_model_buffer_pointer
88  module procedure kim_model_destroy_get_model_buffer_pointer
89  end interface kim_get_model_buffer_pointer
90 
96  interface kim_log_entry
97  module procedure kim_model_destroy_log_entry
98  end interface kim_log_entry
99 
105  interface kim_to_string
106  module procedure kim_model_destroy_to_string
107  end interface kim_to_string
108 
109 contains
113  logical recursive function kim_model_destroy_handle_equal(lhs, rhs)
114  implicit none
115  type(kim_model_destroy_handle_type), intent(in) :: lhs
116  type(kim_model_destroy_handle_type), intent(in) :: rhs
117 
118  if ((.not. c_associated(lhs%p)) .and. (.not. c_associated(rhs%p))) then
119  kim_model_destroy_handle_equal = .true.
120  else
121  kim_model_destroy_handle_equal = c_associated(lhs%p, rhs%p)
122  end if
123  end function kim_model_destroy_handle_equal
124 
128  logical recursive function kim_model_destroy_handle_not_equal(lhs, rhs)
129  implicit none
130  type(kim_model_destroy_handle_type), intent(in) :: lhs
131  type(kim_model_destroy_handle_type), intent(in) :: rhs
132 
133  kim_model_destroy_handle_not_equal = .not. (lhs == rhs)
134  end function kim_model_destroy_handle_not_equal
135 
142  recursive subroutine kim_model_destroy_get_model_buffer_pointer( &
143  model_destroy_handle, ptr)
144  use kim_interoperable_types_module, only: kim_model_destroy_type
145  implicit none
146  interface
147  recursive subroutine get_model_buffer_pointer(model_destroy, ptr) &
148  bind(c, name="KIM_ModelDestroy_GetModelBufferPointer")
149  use, intrinsic :: iso_c_binding
150  use kim_interoperable_types_module, only: kim_model_destroy_type
151  implicit none
152  type(kim_model_destroy_type), intent(in) :: model_destroy
153  type(c_ptr), intent(out) :: ptr
154  end subroutine get_model_buffer_pointer
155  end interface
156  type(kim_model_destroy_handle_type), intent(in) :: model_destroy_handle
157  type(c_ptr), intent(out) :: ptr
158  type(kim_model_destroy_type), pointer :: model_destroy
159 
160  call c_f_pointer(model_destroy_handle%p, model_destroy)
161  call get_model_buffer_pointer(model_destroy, ptr)
162  end subroutine kim_model_destroy_get_model_buffer_pointer
163 
169  recursive subroutine kim_model_destroy_log_entry(model_destroy_handle, &
170  log_verbosity, message)
171  use kim_log_verbosity_module, only: kim_log_verbosity_type
172  use kim_interoperable_types_module, only: kim_model_destroy_type
173  implicit none
174  interface
175  recursive subroutine log_entry( &
176  model_destroy, log_verbosity, message, line_number, file_name) &
177  bind(c, name="KIM_ModelDestroy_LogEntry")
178  use, intrinsic :: iso_c_binding
179  use kim_log_verbosity_module, only: kim_log_verbosity_type
180  use kim_interoperable_types_module, only: kim_model_destroy_type
181  implicit none
182  type(kim_model_destroy_type), intent(in) :: model_destroy
183  type(kim_log_verbosity_type), intent(in), value :: log_verbosity
184  character(c_char), intent(in) :: message(*)
185  integer(c_int), intent(in), value :: line_number
186  character(c_char), intent(in) :: file_name(*)
187  end subroutine log_entry
188  end interface
189  type(kim_model_destroy_handle_type), intent(in) :: model_destroy_handle
190  type(kim_log_verbosity_type), intent(in) :: log_verbosity
191  character(len=*, kind=c_char), intent(in) :: message
192  type(kim_model_destroy_type), pointer :: model_destroy
193 
194  call c_f_pointer(model_destroy_handle%p, model_destroy)
195  call log_entry(model_destroy, log_verbosity, trim(message)//c_null_char, &
196  0, ""//c_null_char)
197  end subroutine kim_model_destroy_log_entry
198 
204  recursive subroutine kim_model_destroy_to_string(model_destroy_handle, string)
205  use kim_convert_string_module, only: kim_convert_c_char_ptr_to_string
206  use kim_interoperable_types_module, only: kim_model_destroy_type
207  implicit none
208  interface
209  type(c_ptr) recursive function model_destroy_string(model_destroy) &
210  bind(c, name="KIM_ModelDestroy_ToString")
211  use, intrinsic :: iso_c_binding
212  use kim_interoperable_types_module, only: kim_model_destroy_type
213  implicit none
214  type(kim_model_destroy_type), intent(in) :: model_destroy
215  end function model_destroy_string
216  end interface
217  type(kim_model_destroy_handle_type), intent(in) :: model_destroy_handle
218  character(len=*, kind=c_char), intent(out) :: string
219  type(kim_model_destroy_type), pointer :: model_destroy
220 
221  type(c_ptr) :: p
222 
223  call c_f_pointer(model_destroy_handle%p, model_destroy)
224  p = model_destroy_string(model_destroy)
225  call kim_convert_c_char_ptr_to_string(p, string)
226  end subroutine kim_model_destroy_to_string
227 end module kim_model_destroy_module
Provides the interface to a KIM API Model object for use by models within their MODEL_ROUTINE_NAME::D...
recursive subroutine kim_model_destroy_to_string(model_destroy_handle, string)
Get a string representing the internal state of the Model object.
recursive subroutine kim_model_destroy_log_entry(model_destroy_handle, log_verbosity, message)
Write a log entry into the log file.
type(kim_model_destroy_handle_type), save, public, protected kim_model_destroy_null_handle
NULL handle for use in comparisons.
static int model_destroy(KIM_ModelDestroy *const modelDestroy)
An Extensible Enumeration for the LogVerbosity's supported by the KIM API.