kim-api  2.3.0+v2.3.0.GNU.GNU.
An Application Programming Interface (API) for the Knowledgebase of Interatomic Models (KIM).
kim_length_unit_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  ! Derive types
42  kim_length_unit_type, &
43  ! Constants
50  ! Routines
51  kim_known, &
52  operator(.eq.), &
53  operator(.ne.), &
54  kim_from_string, &
55  kim_to_string, &
58 
64  type, bind(c) :: kim_length_unit_type
70  integer(c_int) length_unit_id
71  end type kim_length_unit_type
72 
78  type(kim_length_unit_type), protected, save, &
79  bind(c, name="KIM_LENGTH_UNIT_unused") &
81 
87  type(kim_length_unit_type), protected, save, &
88  bind(c, name="KIM_LENGTH_UNIT_A") &
90 
96  type(kim_length_unit_type), protected, save, &
97  bind(c, name="KIM_LENGTH_UNIT_Bohr") &
99 
105  type(kim_length_unit_type), protected, save, &
106  bind(c, name="KIM_LENGTH_UNIT_cm") &
108 
114  type(kim_length_unit_type), protected, save, &
115  bind(c, name="KIM_LENGTH_UNIT_m") &
117 
123  type(kim_length_unit_type), protected, save, &
124  bind(c, name="KIM_LENGTH_UNIT_nm") &
126 
132  interface kim_known
133  module procedure kim_length_unit_known
134  end interface kim_known
135 
141  interface operator(.eq.)
142  module procedure kim_length_unit_equal
143  end interface operator(.eq.)
144 
150  interface operator(.ne.)
151  module procedure kim_length_unit_not_equal
152  end interface operator(.ne.)
153 
160  interface kim_from_string
161  module procedure kim_length_unit_from_string
162  end interface kim_from_string
163 
169  interface kim_to_string
170  module procedure kim_length_unit_to_string
171  end interface kim_to_string
172 
173 contains
179  logical recursive function kim_length_unit_known(length_unit)
180  implicit none
181  interface
182  integer(c_int) recursive function known(length_unit) &
183  bind(c, name="KIM_LengthUnit_Known")
184  use, intrinsic :: iso_c_binding
185  import kim_length_unit_type
186  implicit none
187  type(kim_length_unit_type), intent(in), value :: length_unit
188  end function known
189  end interface
190  type(kim_length_unit_type), intent(in) :: length_unit
191 
192  kim_length_unit_known = (known(length_unit) /= 0)
193  end function kim_length_unit_known
194 
200  logical recursive function kim_length_unit_equal(lhs, rhs)
201  implicit none
202  type(kim_length_unit_type), intent(in) :: lhs
203  type(kim_length_unit_type), intent(in) :: rhs
204 
205  kim_length_unit_equal &
206  = (lhs%length_unit_id == rhs%length_unit_id)
207  end function kim_length_unit_equal
208 
214  logical recursive function kim_length_unit_not_equal(lhs, rhs)
215  implicit none
216  type(kim_length_unit_type), intent(in) :: lhs
217  type(kim_length_unit_type), intent(in) :: rhs
218 
219  kim_length_unit_not_equal = .not. (lhs == rhs)
220  end function kim_length_unit_not_equal
221 
228  recursive subroutine kim_length_unit_from_string(string, length_unit)
229  implicit none
230  interface
231  type(kim_length_unit_type) recursive function from_string(string) &
232  bind(c, name="KIM_LengthUnit_FromString")
233  use, intrinsic :: iso_c_binding
234  import kim_length_unit_type
235  implicit none
236  character(c_char), intent(in) :: string(*)
237  end function from_string
238  end interface
239  character(len=*, kind=c_char), intent(in) :: string
240  type(kim_length_unit_type), intent(out) :: length_unit
241 
242  length_unit = from_string(trim(string)//c_null_char)
243  end subroutine kim_length_unit_from_string
244 
250  recursive subroutine kim_length_unit_to_string(length_unit, string)
251  use kim_convert_string_module, only: kim_convert_c_char_ptr_to_string
252  implicit none
253  interface
254  type(c_ptr) recursive function get_string(length_unit) &
255  bind(c, name="KIM_LengthUnit_ToString")
256  use, intrinsic :: iso_c_binding
257  import kim_length_unit_type
258  implicit none
259  type(kim_length_unit_type), intent(in), value :: length_unit
260  end function get_string
261  end interface
262  type(kim_length_unit_type), intent(in) :: length_unit
263  character(len=*, kind=c_char), intent(out) :: string
264 
265  type(c_ptr) :: p
266 
267  p = get_string(length_unit)
268  call kim_convert_c_char_ptr_to_string(p, string)
269  end subroutine kim_length_unit_to_string
270 
277  recursive subroutine kim_get_number_of_length_units(number_of_length_units)
278  implicit none
279  interface
280  recursive subroutine get_number_of_length_units(number_of_length_units) &
281  bind(c, name="KIM_LENGTH_UNIT_GetNumberOfLengthUnits")
282  use, intrinsic :: iso_c_binding
283  integer(c_int), intent(out) :: number_of_length_units
284  end subroutine get_number_of_length_units
285  end interface
286  integer(c_int), intent(out) :: number_of_length_units
287 
288  call get_number_of_length_units(number_of_length_units)
289  end subroutine kim_get_number_of_length_units
290 
296  recursive subroutine kim_get_length_unit(index, length_unit, ierr)
297  implicit none
298  interface
299  integer(c_int) recursive function get_length_unit(index, length_unit) &
300  bind(c, name="KIM_LENGTH_UNIT_GetLengthUnit")
301  use, intrinsic :: iso_c_binding
302  import kim_length_unit_type
303  implicit none
304  integer(c_int), intent(in), value :: index
305  type(kim_length_unit_type), intent(out) :: length_unit
306  end function get_length_unit
307  end interface
308  integer(c_int), intent(in) :: index
309  type(kim_length_unit_type), intent(out) :: length_unit
310  integer(c_int), intent(out) :: ierr
311 
312  ierr = get_length_unit(index - 1, length_unit)
313  end subroutine kim_get_length_unit
314 end module kim_length_unit_module
type(kim_length_unit_type), save, public, protected kim_length_unit_a
type(kim_length_unit_type), save, public, protected kim_length_unit_bohr
type(kim_length_unit_type), save, public, protected kim_length_unit_m
recursive subroutine, public kim_get_number_of_length_units(number_of_length_units)
Get the number of standard LengthUnit's defined by the KIM API.
type(kim_length_unit_type), save, public, protected kim_length_unit_unused
An Extensible Enumeration for the LengthUnit's supported by the KIM API.
type(kim_length_unit_type), save, public, protected kim_length_unit_nm
recursive subroutine, public kim_get_length_unit(index, length_unit, ierr)
Get the identity of each defined standard LengthUnit.
type(kim_length_unit_type), save, public, protected kim_length_unit_cm