kim-api  2.3.1-git+v2.3.0-git-2-g378406f9.GNU.GNU.
An Application Programming Interface (API) for the Knowledgebase of Interatomic Models (KIM).
kim_log_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.git repository.
28 !
29 
36  use, intrinsic :: iso_c_binding
37  implicit none
38  private
39 
40  public &
41  ! Derived types
42  kim_log_handle_type, &
43  ! Constants
45  ! Routines
46  operator(.eq.), &
47  operator(.ne.), &
50  kim_push_default_verbosity, &
51  kim_pop_default_verbosity, &
52  kim_push_default_print_function, &
53  kim_pop_default_print_function, &
54  kim_convert_c_string, &
55  kim_get_id, &
56  kim_set_id, &
57  kim_push_verbosity, &
58  kim_pop_verbosity, &
59  kim_log_entry
60 
66  type, bind(c) :: kim_log_handle_type
67  type(c_ptr) :: p = c_null_ptr
68  end type kim_log_handle_type
69 
73  type(kim_log_handle_type), protected, save &
75 
79  interface operator(.eq.)
80  module procedure kim_log_handle_equal
81  end interface operator(.eq.)
82 
86  interface operator(.ne.)
87  module procedure kim_log_handle_not_equal
88  end interface operator(.ne.)
89 
95  interface kim_push_default_verbosity
96  module procedure kim_log_push_default_verbosity
97  end interface kim_push_default_verbosity
98 
104  interface kim_pop_default_verbosity
105  module procedure kim_log_pop_default_verbosity
106  end interface kim_pop_default_verbosity
107 
113  interface kim_push_default_print_function
114  module procedure kim_log_push_default_print_function
115  end interface kim_push_default_print_function
116 
122  interface kim_pop_default_print_function
123  module procedure kim_log_pop_default_print_function
124  end interface kim_pop_default_print_function
125 
129  interface kim_convert_c_string
130  module procedure kim_log_convert_c_string
131  end interface kim_convert_c_string
132 
138  interface kim_get_id
139  module procedure kim_log_get_id
140  end interface kim_get_id
141 
147  interface kim_set_id
148  module procedure kim_log_set_id
149  end interface kim_set_id
150 
156  interface kim_push_verbosity
157  module procedure kim_log_push_verbosity
158  end interface kim_push_verbosity
159 
165  interface kim_pop_verbosity
166  module procedure kim_log_pop_verbosity
167  end interface kim_pop_verbosity
168 
174  interface kim_log_entry
175  module procedure kim_log_log_entry
176  end interface kim_log_entry
177 
178 contains
182  logical recursive function kim_log_handle_equal(lhs, rhs)
183  implicit none
184  type(kim_log_handle_type), intent(in) :: lhs
185  type(kim_log_handle_type), intent(in) :: rhs
186 
187  if ((.not. c_associated(lhs%p)) .and. (.not. c_associated(rhs%p))) then
188  kim_log_handle_equal = .true.
189  else
190  kim_log_handle_equal = c_associated(lhs%p, rhs%p)
191  end if
192  end function kim_log_handle_equal
193 
197  logical recursive function kim_log_handle_not_equal(lhs, rhs)
198  implicit none
199  type(kim_log_handle_type), intent(in) :: lhs
200  type(kim_log_handle_type), intent(in) :: rhs
201 
202  kim_log_handle_not_equal = .not. (lhs == rhs)
203  end function kim_log_handle_not_equal
204 
210  recursive subroutine kim_log_create(log_handle, ierr)
211  implicit none
212  interface
213  integer(c_int) recursive function create(log) &
214  bind(c, name="KIM_Log_Create")
215  use, intrinsic :: iso_c_binding
216  implicit none
217  type(c_ptr), intent(out) :: log
218  end function create
219  end interface
220  type(kim_log_handle_type), intent(out) :: log_handle
221  integer(c_int), intent(out) :: ierr
222 
223  type(c_ptr) :: plog
224 
225  ierr = create(plog)
226  log_handle%p = plog
227  end subroutine kim_log_create
228 
234  recursive subroutine kim_log_destroy(log_handle)
235  implicit none
236  interface
237  recursive subroutine destroy(log) bind(c, name="KIM_Log_Destroy")
238  use, intrinsic :: iso_c_binding
239  implicit none
240  type(c_ptr), intent(inout) :: log
241  end subroutine destroy
242  end interface
243  type(kim_log_handle_type), intent(inout) :: log_handle
244 
245  type(c_ptr) :: plog
246  plog = log_handle%p
247  call destroy(plog)
248  log_handle%p = c_null_ptr
249  end subroutine kim_log_destroy
250 
256  recursive subroutine kim_log_push_default_verbosity(log_verbosity)
257  use kim_log_verbosity_module, only: kim_log_verbosity_type
258  implicit none
259  interface
260  recursive subroutine push_default_verbosity(log_verbosity) &
261  bind(c, name="KIM_Log_PushDefaultVerbosity")
262  use, intrinsic :: iso_c_binding
263  use kim_log_verbosity_module, only: kim_log_verbosity_type
264  implicit none
265  type(kim_log_verbosity_type), intent(in), value :: log_verbosity
266  end subroutine push_default_verbosity
267  end interface
268  type(kim_log_verbosity_type), intent(in) :: log_verbosity
269 
270  call push_default_verbosity(log_verbosity)
271  end subroutine kim_log_push_default_verbosity
272 
278  recursive subroutine kim_log_pop_default_verbosity()
279  implicit none
280  interface
281  recursive subroutine pop_default_verbosity() &
282  bind(c, name="KIM_Log_PopDefaultVerbosity")
283  use, intrinsic :: iso_c_binding
284  implicit none
285  end subroutine pop_default_verbosity
286  end interface
287 
288  call pop_default_verbosity()
289  end subroutine kim_log_pop_default_verbosity
290 
334  recursive subroutine kim_log_push_default_print_function(language_name, fptr)
335  use kim_language_name_module, only: kim_language_name_type
336  implicit none
337  interface
338  recursive subroutine push_default_print_function(language_name, fptr) &
339  bind(c, name="KIM_Log_PushDefaultPrintFunction")
340  use, intrinsic :: iso_c_binding
341  use kim_language_name_module, only: kim_language_name_type
342  implicit none
343  type(kim_language_name_type), intent(in), value :: language_name
344  type(c_funptr), intent(in), value :: fptr
345  end subroutine push_default_print_function
346  end interface
347  type(kim_language_name_type), intent(in) :: language_name
348  type(c_funptr), intent(in), value :: fptr ! must be left as "value"!?!
349 
350  call push_default_print_function(language_name, fptr)
351  end subroutine kim_log_push_default_print_function
352 
358  recursive subroutine kim_log_pop_default_print_function()
359  implicit none
360  interface
361  recursive subroutine pop_default_print_function() &
362  bind(c, name="KIM_Log_PopDefaultPrintFunction")
363  use, intrinsic :: iso_c_binding
364  implicit none
365  end subroutine pop_default_print_function
366  end interface
367 
368  call pop_default_print_function()
370 
380  recursive subroutine kim_log_convert_c_string(c_char_ptr, string)
381  use kim_convert_string_module, only: kim_convert_c_char_ptr_to_string
382  implicit none
383  type(c_ptr), intent(in), value :: c_char_ptr
384  character(len=*, kind=c_char), intent(out) :: string
385 
386  call kim_convert_c_char_ptr_to_string(c_char_ptr, string)
387  end subroutine kim_log_convert_c_string
388 
394  recursive subroutine kim_log_get_id(log_handle, id_string)
395  use kim_convert_string_module, only: kim_convert_c_char_ptr_to_string
396  use kim_interoperable_types_module, only: kim_log_type
397  implicit none
398  interface
399  type(c_ptr) recursive function get_id(log) bind(c, name="KIM_Log_GetID")
400  use, intrinsic :: iso_c_binding
401  use kim_interoperable_types_module, only: kim_log_type
402  implicit none
403  type(kim_log_type), intent(in) :: log
404  end function get_id
405  end interface
406  type(kim_log_handle_type), intent(in) :: log_handle
407  character(len=*, kind=c_char), intent(out) :: id_string
408  type(kim_log_type), pointer :: log
409 
410  type(c_ptr) :: p
411 
412  call c_f_pointer(log_handle%p, log)
413  p = get_id(log)
414  call kim_convert_c_char_ptr_to_string(p, id_string)
415  end subroutine kim_log_get_id
416 
422  recursive subroutine kim_log_set_id(log_handle, id_string)
423  use kim_interoperable_types_module, only: kim_log_type
424  implicit none
425  interface
426  recursive subroutine set_id(log, id_string) bind(c, name="KIM_Log_SetID")
427  use, intrinsic :: iso_c_binding
428  use kim_interoperable_types_module, only: kim_log_type
429  implicit none
430  type(kim_log_type), intent(in) :: log
431  character(c_char), intent(in) :: id_string(*)
432  end subroutine set_id
433  end interface
434  type(kim_log_handle_type), intent(in) :: log_handle
435  character(len=*, kind=c_char), intent(in) :: id_string
436  type(kim_log_type), pointer :: log
437 
438  call c_f_pointer(log_handle%p, log)
439  call set_id(log, trim(id_string)//c_null_char)
440  end subroutine kim_log_set_id
441 
447  recursive subroutine kim_log_push_verbosity(log_handle, log_verbosity)
448  use kim_log_verbosity_module, only: kim_log_verbosity_type
449  use kim_interoperable_types_module, only: kim_log_type
450  implicit none
451  interface
452  recursive subroutine push_verbosity(log, log_verbosity) &
453  bind(c, name="KIM_Log_PushVerbosity")
454  use, intrinsic :: iso_c_binding
455  use kim_log_verbosity_module, only: kim_log_verbosity_type
456  use kim_interoperable_types_module, only: kim_log_type
457  implicit none
458  type(kim_log_type), intent(in) :: log
459  type(kim_log_verbosity_type), intent(in), value :: log_verbosity
460  end subroutine push_verbosity
461  end interface
462  type(kim_log_handle_type), intent(in) :: log_handle
463  type(kim_log_verbosity_type), intent(in) :: log_verbosity
464  type(kim_log_type), pointer :: log
465 
466  call c_f_pointer(log_handle%p, log)
467  call push_verbosity(log, log_verbosity)
468  end subroutine kim_log_push_verbosity
469 
475  recursive subroutine kim_log_pop_verbosity(log_handle)
476  use kim_interoperable_types_module, only: kim_log_type
477  implicit none
478  interface
479  recursive subroutine pop_verbosity(log) &
480  bind(c, name="KIM_Log_PopVerbosity")
481  use, intrinsic :: iso_c_binding
482  use kim_interoperable_types_module, only: kim_log_type
483  implicit none
484  type(kim_log_type), intent(in) :: log
485  end subroutine pop_verbosity
486  end interface
487  type(kim_log_handle_type), intent(in) :: log_handle
488  type(kim_log_type), pointer :: log
489 
490  call c_f_pointer(log_handle%p, log)
491  call pop_verbosity(log)
492  end subroutine kim_log_pop_verbosity
493 
499  recursive subroutine kim_log_log_entry(log_handle, log_verbosity, message)
500  use kim_log_verbosity_module, only: kim_log_verbosity_type
501  use kim_interoperable_types_module, only: kim_log_type
502  implicit none
503  interface
504  recursive subroutine log_entry(log, log_verbosity, message, line_number, &
505  file_name) bind(c, name="KIM_Log_LogEntry")
506  use, intrinsic :: iso_c_binding
507  use kim_log_verbosity_module, only: kim_log_verbosity_type
508  use kim_interoperable_types_module, only: kim_log_type
509  implicit none
510  type(kim_log_type), intent(in) :: log
511  type(kim_log_verbosity_type), intent(in), value :: log_verbosity
512  character(c_char), intent(in) :: message(*)
513  integer(c_int), intent(in), value :: line_number
514  character(c_char), intent(in) :: file_name(*)
515  end subroutine log_entry
516  end interface
517  type(kim_log_handle_type), intent(in) :: log_handle
518  type(kim_log_verbosity_type), intent(in) :: log_verbosity
519  character(len=*, kind=c_char), intent(in) :: message
520  type(kim_log_type), pointer :: log
521 
522  call c_f_pointer(log_handle%p, log)
523  call log_entry(log, log_verbosity, trim(message)//c_null_char, &
524  0, ""//c_null_char)
525  end subroutine kim_log_log_entry
526 end module kim_log_module
recursive subroutine, public kim_log_create(log_handle, ierr)
Create a new KIM API Log object.
recursive subroutine kim_log_set_id(log_handle, id_string)
Set the identity of the Log object.
recursive subroutine, public kim_log_destroy(log_handle)
Destroy a previously Log::Create'd object.
Provides the logging interface for the KIM API.
type(kim_log_handle_type), save, public, protected kim_log_null_handle
NULL handle for use in comparisons.
recursive subroutine kim_log_get_id(log_handle, id_string)
Get the identity of the Log object.
An Extensible Enumeration for the LanguageName's supported by the KIM API.
recursive subroutine kim_log_pop_default_verbosity()
Pop a LogVerbosity from the KIM API global default verbosity stack.
recursive subroutine kim_log_pop_verbosity(log_handle)
Pop a LogVerbosity from the Log object's verbosity stack.
recursive subroutine kim_log_log_entry(log_handle, log_verbosity, message)
Write a log entry into the log file.
recursive subroutine kim_log_push_verbosity(log_handle, log_verbosity)
Push a new LogVerbosity onto the Log object's verbosity stack.
recursive subroutine kim_log_pop_default_print_function()
Pop a log PrintFunction from the KIM API global default log PrintFunction stack.
An Extensible Enumeration for the LogVerbosity's supported by the KIM API.