Octopus
messages.F90
Go to the documentation of this file.
1!! Copyright (C) 2002-2021 M. Marques, A. Castro, A. Rubio, G. Bertsch, X. Andrade,
2!! Copyright (C) 2021 M. Lueders
3!!
4!! This program is free software; you can redistribute it and/or modify
5!! it under the terms of the GNU General Public License as published by
6!! the Free Software Foundation; either version 2, or (at your option)
7!! any later version.
8!!
9!! This program is distributed in the hope that it will be useful,
10!! but WITHOUT ANY WARRANTY; without even the implied warranty of
11!! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12!! GNU General Public License for more details.
13!!
14!! You should have received a copy of the GNU General Public License
15!! along with this program; if not, write to the Free Software
16!! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
17!! 02110-1301, USA.
18!!
19
20#include "global.h"
21
22module messages_oct_m
23 use debug_oct_m
24 use global_oct_m
25 use io_oct_m
26 use loct_oct_m
27 use mpi_oct_m
29 use parser_oct_m
30 use string_oct_m
31 use sihash_oct_m
32 use sphash_oct_m
33 use unit_oct_m
35
36 implicit none
37
38 private
39
40 public :: &
47 print_date, &
48 time_sum, &
64
65
66 integer, parameter :: max_lines = 20
67 character(len=256), dimension(max_lines), public :: message
68 character(len=68), parameter, public :: hyphens = &
69 '--------------------------------------------------------------------'
70 character(len=69), parameter, public :: shyphens = '*'//hyphens
71
72 character(len=512), private :: msg
73 integer, parameter, private :: SLEEPYTIME_ALL = 1, sleepytime_nonwriters = 60
74 character(len=64), private :: oct_status = 'undefined'
75
76 type(sihash_t), private :: namespace_unit
77 type(sphash_t), private :: namespace_mpi_grp
78 character(len=256), private :: msg_dir = 'exec'
79
80 ! ---------------------------------------------------------
86 ! ---------------------------------------------------------
88 module procedure messages_print_var_valuei
89 module procedure messages_print_var_values
90 module procedure messages_print_var_valuer
91 module procedure messages_print_var_valuel
92 module procedure messages_print_var_valuear
93 end interface messages_print_var_value
94
95 interface messages_write
96 module procedure messages_write_float
97 module procedure messages_write_integer
98 module procedure messages_write_integer8
99 module procedure messages_write_str
100 module procedure messages_write_logical
101 end interface messages_write
102
103
105 module procedure messages_print_var_option_4
106 module procedure messages_print_var_option_8
107 end interface messages_print_var_option
108
109 integer :: warnings
110 integer :: experimentals
111 integer :: current_line
112
114 interface
115 subroutine trap_segfault()
116 implicit none
117 end subroutine trap_segfault
118 end interface
119
120
121contains
122
123 ! ---------------------------------------------------------
124 subroutine messages_init(output_dir)
125 character(len=*), intent(in), optional :: output_dir
126
127 logical :: trap_signals
128
129 if (present(output_dir)) then
130 msg_dir = trim(output_dir)
131 endif
132
133 call sihash_init(namespace_unit)
134 call sphash_init(namespace_mpi_grp)
135
136 call messages_obsolete_variable(global_namespace, 'DevelVersion', 'ExperimentalFeatures')
137
138 !%Variable ExperimentalFeatures
139 !%Type logical
140 !%Default no
141 !%Section Execution::Debug
142 !%Description
143 !% If true, allows the use of certain parts of the code that are
144 !% still under development and are not suitable for production
145 !% runs. This should not be used unless you know what you are doing.
146 !% See details on
147 !% <a href=https://www.octopus-code.org/documentation/main/variables/execution/debug/experimentalfeatures>wiki page</a>.
148 !%End
149 call parse_variable(global_namespace, 'ExperimentalFeatures', .false., conf%devel_version)
150
151 call messages_obsolete_variable(global_namespace, 'DebugLevel', 'Debug')
152
154
155 warnings = 0
156 experimentals = 0
157
158 !%Variable DebugTrapSignals
159 !%Type logical
160 !%Default yes
161 !%Section Execution::Debug
162 !%Description
163 !% If true, trap signals to handle them in octopus itself and
164 !% print a custom backtrace. If false, do not trap signals; then,
165 !% core dumps can be produced or gdb can be used to stop at the
166 !% point a signal was produced (e.g. a segmentation fault).
167 !%End
168 call parse_variable(global_namespace, 'DebugTrapSignals', .true., trap_signals)
170 if (trap_signals) call trap_segfault()
174 end subroutine messages_init
175
176 ! ---------------------------------------------------------
177 subroutine messages_end()
178
179 type(sihash_iterator_t) :: it
180 integer :: iu
181
182 if (mpi_world%is_root()) then
183
184 if (experimentals > 0 .or. warnings > 0) then
185 message(1) = ''
186 call messages_info(1)
187 end if
188
189
190 if (warnings > 0) then
191 call messages_write('Octopus emitted ')
192 call messages_write(warnings)
193 if (warnings > 1) then
194 call messages_write(' warnings.')
195 else
196 call messages_write(' warning.')
197 end if
198 call messages_info()
199 end if
200
201 if (experimentals > 0) then
202 call messages_new_line()
203 call messages_write('Octopus used ')
204 call messages_write(experimentals)
205 if (experimentals > 1) then
206 call messages_write(' experimental features:')
207 else
208 call messages_write(' experimental feature:')
209 end if
211 call messages_new_line()
212 call messages_write(' Since you used one or more experimental features, results are likely')
213 call messages_new_line()
214 call messages_write(' wrong and should not be considered as valid scientific data. Check')
215 call messages_new_line()
216 call messages_new_line()
217 call messages_write(' https://www.octopus-code.org/documentation/main/variables/execution/debug/experimentalfeatures')
218 call messages_new_line()
220 call messages_write(' or contact the octopus developers for details.')
221 call messages_new_line()
222 call messages_info()
223 end if
224
225 open(unit = iunit_out, file = trim(msg_dir) // '/messages', action = 'write')
226 write(iunit_out, '(a, i9)') "warnings = ", warnings
227 write(iunit_out, '(a, i9)') "experimental = ", experimentals
228 close(iunit_out)
229
230 end if
231
232 call it%start(namespace_unit)
233 do while(it%has_next())
234 iu = it%get_next()
235 if (iu /= stderr .and. iu /= stdout) call io_close(iu)
236 end do
237
238 call sphash_end(namespace_mpi_grp)
239 call sihash_end(namespace_unit)
240
241 end subroutine messages_end
242
243 ! ---------------------------------------------------------
244 integer function messages_get_unit(namespace) result(iunit)
245 type(namespace_t), optional, intent(in) :: namespace
246
247 logical :: found
248
249 if (present(namespace)) then
250
251 if (namespace%get()=="") then
252 iunit = stdout
253 return
254 end if
255
256 iunit = sihash_lookup( namespace_unit, namespace%get(), found)
257
258 if (.not. found) then
259 call io_mkdir('', namespace)
260 iunit = io_open("log", namespace=namespace, action="write")
261 call sihash_insert(namespace_unit, namespace%get(), iunit)
262 endif
263
264 else
265 iunit = stdout
266 end if
267
268 end function messages_get_unit
269
270 ! ---------------------------------------------------------
271 subroutine messages_update_mpi_grp(namespace, mpigrp)
272 type(namespace_t), intent(in) :: namespace
273 type(mpi_grp_t), target, intent(in) :: mpigrp
274
275 ! messages not initialised
276 assert(namespace_mpi_grp%is_associated())
277 call sphash_insert(namespace_mpi_grp, namespace%get(), mpigrp, clone=.true.)
278
279 end subroutine messages_update_mpi_grp
280
281 ! ---------------------------------------------------------
282 function messages_get_mpi_grp(namespace) result(grp)
283 type(namespace_t), optional, intent(in) :: namespace
284 type(mpi_grp_t) :: grp
285
286 class(*), pointer :: value
287 logical :: found
288
289 if (present(namespace)) then
290 ! messages not initialised
291 assert(namespace_mpi_grp%is_associated())
292
293 value => sphash_lookup(namespace_mpi_grp, trim(namespace%get()), found)
294
295 if (.not.found) then
296 grp = mpi_world
297 return
298 endif
299
300 select type(value)
301 type is (mpi_grp_t)
302 grp = value
303 class default
304 write(message(1),*) "Cannot get mpi_grp for namespace ",namespace%get()
305 call messages_fatal(1)
306 end select
307 else
308 grp = mpi_world
309 end if
310
311 end function messages_get_mpi_grp
312
313 ! ---------------------------------------------------------
314 subroutine messages_fatal(no_lines, only_root_writes, namespace)
315 integer, optional, intent(in) :: no_lines
316 logical, optional, intent(in) :: only_root_writes
317 type(namespace_t), optional, intent(in) :: namespace
318
319 type(mpi_grp_t) :: msg_mpi_grp
320 integer :: ii, no_lines_
321 logical :: only_root_writes_, should_write
322 integer, allocatable :: recv_buf(:)
323 type(mpi_request), allocatable :: recv_req(:)
324#ifdef HAVE_MPI
325 integer, parameter :: fatal_tag = 32767
326 logical :: received
327 type(mpi_request) :: send_req
328#endif
329
330 no_lines_ = current_line
331 if (present(no_lines)) no_lines_ = no_lines
332
333 msg_mpi_grp = messages_get_mpi_grp(namespace)
334
335 if (present(only_root_writes)) then
336 should_write = msg_mpi_grp%is_root() .or. (.not. only_root_writes)
337 only_root_writes_ = only_root_writes
338 else
339 should_write = .true.
340 only_root_writes_ = .false.
341 end if
342
343 ! This is to avoid all nodes reporting an error. The root node
344 ! post a message reception to all nodes, the rest of the nodes
345 ! send a message. If the message is received, the non-root nodes
346 ! know that the root node will report the error, so they do not do
347 ! anything.
348
349 if (.not. only_root_writes_) then
350 if (msg_mpi_grp%is_root()) then
351
352 allocate(recv_buf(1:mpi_world%size - 1))
353 allocate(recv_req(1:mpi_world%size - 1))
354 do ii = 1, mpi_world%size - 1
355#ifdef HAVE_MPI
356 call mpi_recv_init(recv_buf(ii), 1, mpi_integer, ii, fatal_tag, msg_mpi_grp%comm, recv_req(ii))
357#endif
358 end do
359 deallocate(recv_buf)
360 deallocate(recv_req)
361
362 else
363
364#ifdef HAVE_MPI
365 call mpi_send_init(1, 1, mpi_integer, 0, fatal_tag, msg_mpi_grp%comm, send_req)
366#endif
367 !sleep for a second and check
368 call loct_nanosleep(sleepytime_all, 0)
369#ifdef HAVE_MPI
370 call mpi_test(send_req, received, mpi_status_ignore)
371#endif
372 should_write = .false.
373
374 end if
375 end if
376
377 ! Give a moment for all standard output hopefully to be printed
378 call loct_nanosleep(sleepytime_all, 0)
379
380 ! If we are not writing wait for the root node to get here and
381 ! write the error message. If the root doesn`t get here, we all print the
382 ! error messsage anyways and die. Otherwise, no message might be written.
383 if (.not. should_write) call loct_nanosleep(sleepytime_nonwriters, 0)
384
385 call messages_print_with_emphasis(msg="FATAL ERROR", iunit=stderr)
386 write(msg, '(a)') '*** Fatal Error (description follows)'
387 call flush_msg(msg, stderr)
388
389 if (present(namespace)) then
390 if (len_trim(namespace%get()) > 0) then
391 write(msg, '(3a)') '* In namespace ', trim(namespace%get()), ':'
392 call flush_msg(msg, stderr)
393 end if
394 end if
395
396#ifdef HAVE_MPI
397 if (.not. only_root_writes_ .or. .not. msg_mpi_grp%is_root()) then
398 call flush_msg(shyphens, stderr)
399 write(msg, '(a,i4)') "* From node = ", msg_mpi_grp%rank
400 call flush_msg(msg, stderr)
401 end if
402#endif
403 call flush_msg(shyphens, stderr)
404 do ii = 1, no_lines_
405 write(msg, '(a,1x,a)') '*', trim(message(ii))
406 call flush_msg(msg, stderr)
407 end do
408
409 ! We only dump the stack in debug mode because subroutine invocations
410 ! are only recorded in debug mode (via push_sub/pop_sub). Otherwise,
411 ! it is a bit confusing that the stack seems to be empty.
412 if (debug%trace) then
413 call flush_msg(shyphens, stderr)
414
415 write(msg, '(a)') '* Stack: '
416 call flush_msg(msg, stderr, adv='no')
417 do ii = 1, no_sub_stack
418 write(msg, '(a,a)') ' > ', trim(sub_stack(ii))
419 call flush_msg(msg, stderr, adv='no')
420 end do
421 call flush_msg(" ", stderr)
422 end if
423
424 if (should_write) then
425 call messages_print_with_emphasis(iunit=stderr)
426 end if
427
428 ! switch file indicator to state aborted
429 call messages_switch_status('aborted')
430
431 call mpi_world%abort()
432
433 end subroutine messages_fatal
434
435 ! ---------------------------------------------------------
436 subroutine messages_warning(no_lines, all_nodes, namespace)
437 integer, optional, intent(in) :: no_lines
438 logical, optional, intent(in) :: all_nodes
439 type(namespace_t), optional, intent(in) :: namespace
440
441 integer :: il, no_lines_
442 integer :: iunit_namespace
443 logical :: have_to_write, all_nodes_
444 type(mpi_grp_t) :: msg_mpi_grp
445
446 no_lines_ = current_line
447 if (present(no_lines)) no_lines_ = no_lines
448
449 warnings = warnings + 1
450
451 iunit_namespace = messages_get_unit(namespace)
452 msg_mpi_grp = messages_get_mpi_grp(namespace)
453
454 have_to_write = msg_mpi_grp%is_root()
455
456 all_nodes_ = .false.
457 if (present(all_nodes)) then
458 have_to_write = have_to_write .or. all_nodes
459 all_nodes_ = all_nodes
460 end if
461
462 if (have_to_write) then
463
464 call flush_msg('', stderr)
465 if (iunit_namespace /= stdout) then
466 call flush_msg('', iunit_namespace)
467 end if
468 write(msg, '(a)') '** Warning:'
469 call flush_msg(msg, stderr)
470 if (iunit_namespace /= stdout) then
471 call flush_msg(msg, iunit_namespace)
472 end if
473
474 if (present(namespace)) then
475 if (len_trim(namespace%get()) > 0) then
476 write(msg, '(3a)') '** In namespace ', trim(namespace%get()), ':'
477 call flush_msg(msg, stderr)
478 end if
479 end if
480
481#ifdef HAVE_MPI
482 if (all_nodes_) then
483 write(msg , '(a,i4)') '** From node = ', mpi_world%rank
484 call flush_msg(msg, stderr)
485 if (iunit_namespace /= stdout) then
486 call flush_msg(msg, iunit_namespace)
487 end if
488 end if
489#endif
490
491 do il = 1, no_lines_
492 write(msg , '(a,3x,a)') '**', trim(message(il))
493 call flush_msg(msg, stderr)
494 if (iunit_namespace /= stdout) then
495 call flush_msg(msg, iunit_namespace)
496 end if
497 end do
498 call flush_msg('', stderr)
499 if (iunit_namespace /= stdout) then
500 call flush_msg('', iunit_namespace)
501 end if
502
503 flush(stderr)
504 if (iunit_namespace /= stdout) then
505 flush(iunit_namespace)
506 end if
507
508 end if
509
511
512 end subroutine messages_warning
513
514 ! ---------------------------------------------------------
515 subroutine messages_info(no_lines, iunit, debug_only, stress, all_nodes, namespace)
516 integer, optional, intent(in) :: no_lines
517 integer, optional, intent(in) :: iunit
518 logical, optional, intent(in) :: debug_only
519 logical, optional, intent(in) :: stress
520 logical, optional, intent(in) :: all_nodes
521 type(namespace_t), optional, intent(in) :: namespace
522
523 integer :: il, no_lines_
524 integer :: iunit_
525 type(mpi_grp_t) :: msg_mpi_grp
526
527 assert(.not. (present(iunit) .and. present(namespace)))
528
529 if (present(iunit)) then
530 iunit_ = iunit
531 else
532 iunit_ = messages_get_unit(namespace)
533 end if
534 msg_mpi_grp = messages_get_mpi_grp(namespace)
535
536 if (.not. msg_mpi_grp%is_root() .and. .not. optional_default(all_nodes, .false.)) then
538 return
539 end if
540
541 no_lines_ = current_line
542 if (present(no_lines)) no_lines_ = no_lines
543
544 if (present(stress)) then
545 call messages_print_with_emphasis(iunit=iunit_)
546 end if
547
548 do il = 1, no_lines_
549 if (.not. optional_default(debug_only, .false.) .or. debug%info) then
550 write(msg, '(a)') trim(message(il))
551 call flush_msg(msg, iunit_)
552 end if
553 end do
554 if (present(stress)) then
555 call messages_print_with_emphasis(iunit=iunit_)
556 end if
557
558 flush(iunit_)
559
561
562 end subroutine messages_info
563
564 ! ---------------------------------------------------------
566 subroutine messages_switch_status(status)
567 character(len=*), intent(in) :: status
568
569 ! only root node is taking care of file I/O
570 if (.not. mpi_world%is_root()) return
571
572 ! remove old status files first, before we switch to a new state
573 call loct_rm(trim(msg_dir) // '/oct-status-running')
574 call loct_rm(trim(msg_dir) // '/oct-status-finished')
575 call loct_rm(trim(msg_dir) // '/oct-status-aborted')
576 if (oct_status /= 'walltimer-aborted') then
577 call loct_rm(trim(msg_dir) // '/oct-status-walltimer-aborted')
578 end if
579
580 oct_status = status
581
582 ! create empty status file to indicate new state
583 open(unit=iunit_err, file=trim(msg_dir) // '/oct-status-'//trim(status), &
584 action='write', status='unknown')
585 close(iunit_err)
586
587 end subroutine messages_switch_status
588
589 ! ---------------------------------------------------------
590 subroutine alloc_error(size, file, line)
591 integer(int64), intent(in) :: size
592 character(len=*), intent(in) :: file
593 integer, intent(in) :: line
594
595 write(message(1), '(a,i18,3a,i5)') "Failed to allocate ", size, " words in file '", trim(file), "' line ", line
596 call messages_fatal(1)
597
598 end subroutine alloc_error
599
600 ! ---------------------------------------------------------
601 subroutine dealloc_error(size, file, line)
602 integer(int64), intent(in) :: size
603 character(len=*), intent(in) :: file
604 integer, intent(in) :: line
605
606 write(message(1), '(a,i18,3a,i5)') "Failed to deallocate array of ", size, " words in file '", trim(file), "' line ", line
607 call messages_fatal(1)
608
609 end subroutine dealloc_error
610
611 ! ---------------------------------------------------------
612 subroutine messages_input_error(namespace, var, details, row, column)
613 type(namespace_t), intent(in) :: namespace
614 character(len=*), intent(in) :: var
615 character(len=*), optional, intent(in) :: details
616 integer, optional, intent(in) :: row
617 integer, optional, intent(in) :: column
618
619 character(len=10) :: row_str, column_str
620
621 call messages_write('Input error in the input variable '// trim(var))
622
623 if (present(row)) then
624 ! Print row and, if available, the column. We add one to both values
625 ! in order to translate from the C numbering used by the parser to a
626 ! more human-friendly numbering.
627 write(row_str, '(I10)') row + 1
628 call messages_write(' at row '//adjustl(row_str))
629 if (present(column)) then
630 write(column_str, '(I10)') column + 1
631 call messages_write(', column '//adjustl(column_str))
632 end if
633 end if
634 if (present(details)) then
635 call messages_write(':', new_line = .true.)
636 call messages_new_line()
637 call messages_write(' '//trim(details))
638 end if
639 call messages_write('.', new_line = .true.)
640
641 call messages_new_line()
642
643 call messages_write('You can get the documentation of the variable with the command:', new_line = .true.)
644 call messages_write(' oct-help -p '//trim(var))
645 call messages_fatal(namespace=namespace)
646
647 end subroutine messages_input_error
648
649 ! ---------------------------------------------------------
650 subroutine messages_print_var_valuei(var, val, iunit, namespace)
651 character(len=*), intent(in) :: var
652 integer, intent(in) :: val
653 integer, optional, intent(in) :: iunit
654 type(namespace_t), optional, intent(in) :: namespace
655
656 character(len=10) :: intstring
657
658 assert(.not. (present(iunit) .and. present(namespace)))
659
660 write(intstring,'(i10)') val
661 message(1) = 'Input: ['//trim(var)//' = '//trim(adjustl(intstring))//']'
662 call messages_info(1, iunit=iunit, namespace=namespace)
663
664 end subroutine messages_print_var_valuei
665
666 ! ---------------------------------------------------------
667 subroutine messages_print_var_values(var, val, iunit, namespace)
668 character(len=*), intent(in) :: var
669 character(len=*), intent(in) :: val
670 integer, optional, intent(in) :: iunit
671 type(namespace_t), optional, intent(in) :: namespace
672
673 assert(.not. (present(iunit) .and. present(namespace)))
674
675 message(1) = 'Input: ['//trim(var)//' = '//trim(val)//']'
676 call messages_info(1, iunit=iunit, namespace=namespace)
677
678 end subroutine messages_print_var_values
680 ! ---------------------------------------------------------
681 subroutine messages_print_var_valuer(var, val, unit, iunit, namespace)
682 character(len=*), intent(in) :: var
683 real(real64), intent(in) :: val
684 type(unit_t), optional, intent(in) :: unit
685 integer, optional, intent(in) :: iunit
686 type(namespace_t), optional, intent(in) :: namespace
687
688 character(len=11) :: floatstring
689
690 assert(.not. (present(iunit) .and. present(namespace)))
691
692 if (.not. present(unit)) then
693 write(floatstring,'(g11.4)') val
694 message(1) = 'Input: ['//trim(var)//' = '//trim(adjustl(floatstring))//']'
695 else
696 write(floatstring,'(g11.4)') units_from_atomic(unit, val)
697 message(1) = 'Input: ['//trim(var)//' = '//trim(adjustl(floatstring))//' '//trim(units_abbrev(unit))//']'
698 end if
699 call messages_info(1, iunit=iunit, namespace=namespace)
700
701 end subroutine messages_print_var_valuer
702
703 ! ---------------------------------------------------------
704 subroutine messages_print_var_valuel(var, val, iunit, namespace)
705 character(len=*), intent(in) :: var
706 logical, intent(in) :: val
707 integer, optional, intent(in) :: iunit
708 type(namespace_t), optional, intent(in) :: namespace
709
710 character(len=3) :: lstring
711
712 assert(.not. (present(iunit) .and. present(namespace)))
713
714 if (val) then
715 lstring = 'yes'
716 else
717 lstring = 'no'
718 end if
719 message(1) = 'Input: ['//trim(var)//' = '//trim(lstring)//']'
720 call messages_info(1, iunit=iunit, namespace=namespace)
721
722 end subroutine messages_print_var_valuel
723
724 ! ---------------------------------------------------------
725 subroutine messages_print_var_valuear(var, val, unit, iunit, namespace)
726 character(len=*), intent(in) :: var
727 real(real64), intent(in) :: val(:)
728 type(unit_t), optional, intent(in) :: unit
729 integer, optional, intent(in) :: iunit
730 type(namespace_t), optional, intent(in) :: namespace
731
732 integer :: ii
733 character(len=11) :: floatstring
734
735 assert(.not. (present(iunit) .and. present(namespace)))
736
737 call messages_write('Input: ['//trim(var)//' = (')
738 do ii = 1, size(val)
739 write(floatstring,'(g11.4)') val(ii)
740 call messages_write(trim(adjustl(floatstring)))
741 if (ii < size(val)) call messages_write(', ')
742 end do
743 call messages_write(')')
744 if (present(unit)) then
745 call messages_write(' '//trim(units_abbrev(unit))//']')
746 else
747 call messages_write(']')
748 end if
749 call messages_info(iunit = iunit, namespace=namespace)
750
751 end subroutine messages_print_var_valuear
752
753 ! ---------------------------------------------------------
754 subroutine messages_print_var_info(var, iunit, namespace)
755 character(len=*), intent(in) :: var
756 integer, optional, intent(in) :: iunit
757 type(namespace_t), optional, intent(in) :: namespace
758
759 integer :: iunit_
760 type(mpi_grp_t) :: mpi_grp
761
762 assert(.not. (present(iunit) .and. present(namespace)))
763
764 mpi_grp = messages_get_mpi_grp(namespace)
765
766 if (.not. mpi_grp%is_root()) return
767
768 if (present(iunit)) then
769 iunit_ = iunit
770 else
771 iunit_ = messages_get_unit(namespace)
772 end if
773 call varinfo_print(iunit_, var)
774
775 end subroutine messages_print_var_info
776
777 ! ---------------------------------------------------------
778 subroutine messages_print_var_option_8(var, option, pre, iunit, namespace)
779 character(len=*), intent(in) :: var
780 integer(int64), intent(in) :: option
781 character(len=*), optional, intent(in) :: pre
782 integer, optional, intent(in) :: iunit
783 type(namespace_t), optional, intent(in) :: namespace
784
785 integer :: option4, iunit_
786 type(mpi_grp_t) :: mpi_grp
787
788 assert(.not. (present(iunit) .and. present(namespace)))
789
790 mpi_grp = messages_get_mpi_grp(namespace)
791 if (.not. mpi_grp%is_root()) return
792
793 option4 = int(option, int32)
794
795 if (present(iunit)) then
796 iunit_ = iunit
797 else
798 iunit_ = messages_get_unit(namespace)
799 end if
800 call varinfo_print_option(iunit_, var, option4, pre)
801
802 end subroutine messages_print_var_option_8
804 ! ---------------------------------------------------------
805 subroutine messages_print_var_option_4(var, option, pre, iunit, namespace)
806 character(len=*), intent(in) :: var
807 integer(int32), intent(in) :: option
808 character(len=*), optional, intent(in) :: pre
809 integer, optional, intent(in) :: iunit
810 type(namespace_t), optional, intent(in) :: namespace
811
812 assert(.not. (present(iunit) .and. present(namespace)))
813
814 call messages_print_var_option_8(var, int(option, int64), pre, iunit, namespace)
815
816 end subroutine messages_print_var_option_4
817
818 ! ---------------------------------------------------------
819 subroutine messages_print_with_emphasis(msg, iunit, namespace)
820 character(len=*), optional, intent(in) :: msg
821 integer, optional, intent(in) :: iunit
822 type(namespace_t), optional, intent(in) :: namespace
823
824 integer, parameter :: max_len = 70
825
826 integer :: ii, jj, length
827 integer :: iunit_
828 character(len=70) :: str
829 character(len=max_len) :: msg_combined
830 type(mpi_grp_t) :: msg_mpi_grp
831
832 if (present(iunit)) then
833 iunit_ = iunit
834 else
835 iunit_ = messages_get_unit(namespace)
836 end if
837 msg_mpi_grp = messages_get_mpi_grp(namespace)
838
839 if (.not. msg_mpi_grp%is_root()) return
840
841 if (present(msg)) then
842 ! make sure we do not get a segfault for too long messages
843 if (len_trim(msg) > max_len) then
844 msg_combined = trim(msg(1:max_len))
845 else
846 msg_combined = trim(msg)
847 end if
848 length = len_trim(msg_combined)
849
850 str = ''
851 jj = 1
852
853 do ii = 1, (max_len - (length + 2))/2
854 str(jj:jj) = '*'
855 jj = jj + 1
856 end do
857
858 str(jj:jj) = ' '
859 jj = jj + 1
860
861 do ii = 1, length
862 str(jj:jj) = msg_combined(ii:ii)
863 jj = jj + 1
864 end do
865
866 str(jj:jj) = ' '
867 jj = jj + 1
868
869 do ii = jj, max_len
870 str(jj:jj) = '*'
871 jj = jj + 1
872 end do
873
874 call flush_msg('', iunit_) ! empty line
875 call flush_msg(str, iunit_) ! print out nice line with the header
876 else
877 do ii = 1, max_len
878 str(ii:ii) = '*'
879 end do
880
881 call flush_msg(str, iunit_) ! print out nice line with the header
882 call flush_msg('', iunit_) ! empty line
883 end if
884
885 flush(iunit_)
886 end subroutine messages_print_with_emphasis
887
888 ! ---------------------------------------------------------
889 subroutine flush_msg(str, iunit, adv)
890 character(len = *), intent(in) :: str
891 integer, intent(in) :: iunit
892 character(len = *), optional, intent(in) :: adv
893
894 character(len = 20) :: adv_
895
896 adv_ = 'yes'
897 if (present(adv)) adv_ = trim(adv)
898
899 write(iunit, '(a)', advance=adv_) trim(str)
900
901 end subroutine flush_msg
902
903 ! ---------------------------------------------------------
904 subroutine print_date(str)
905 character(len = *), intent(in) :: str
906
907 integer :: val(8)
908
909 call date_and_time(values=val)
910 message(1) = ""
911 write(message(3),'(a,i4,a1,i2.2,a1,i2.2,a,i2.2,a1,i2.2,a1,i2.2)') &
912 str , val(1), "/", val(2), "/", val(3), &
913 " at ", val(5), ":", val(6), ":", val(7)
914 message(2) = str_center(trim(message(3)), 70)
915 message(3) = ""
916 call messages_info(3)
917
918 end subroutine print_date
919
920 ! ---------------------------------------------------------
923 subroutine time_sum(sec1, usec1, sec2, usec2)
924 integer, intent(in) :: sec1
925 integer, intent(in) :: usec1
926 integer, intent(inout) :: sec2
927 integer, intent(inout) :: usec2
928
929 push_sub(time_sum)
930
931 sec2 = sec1 + sec2
932 usec2 = usec1 + usec2
933
934 ! Carry?
935 if (usec2 >= 1000000) then
936 sec2 = sec2 + 1
937 usec2 = usec2 - 1000000
938 end if
939
940 pop_sub(time_sum)
941 end subroutine time_sum
942
943 ! ---------------------------------------------------------
944 subroutine messages_obsolete_variable(namespace, name, rep)
945 type(namespace_t), intent(in) :: namespace
946 character(len=*), intent(in) :: name
947 character(len=*), optional, intent(in) :: rep
948
949 if (parse_is_defined(namespace, trim(name))) then
950
951 write(message(1), '(a)') 'Input variable '//trim(name)//' is obsolete.'
952
953 if (present(rep)) then
954 write(message(2), '(a)') ' '
955 write(message(3), '(a)') 'Equivalent functionality can be obtained with the '//trim(rep)
956 write(message(4), '(a)') 'variable. Check the documentation for details.'
957 write(message(5), '(a)') '(You can use the `oct-help -p '//trim(rep)//'` command).'
958 call messages_fatal(5, only_root_writes = .true., namespace=namespace)
959 else
960 call messages_fatal(1, only_root_writes = .true., namespace=namespace)
961 end if
962
963 end if
964
965 end subroutine messages_obsolete_variable
966
967 ! ---------------------------------------------------------
968 subroutine messages_variable_is_block(namespace, name)
969 type(namespace_t), intent(in) :: namespace
970 character(len=*), intent(in) :: name
971
972 if (parse_is_defined(namespace, trim(name))) then
973
974 write(message(1), '(a)') 'Input variable `'//trim(name)//'` must be defined as a block.'
975 write(message(2), '(a)') 'Please check the documentation for details.'
976 write(message(3), '(a)') '(You can use the `oct-help -p '//trim(name)//'` command).'
977 call messages_fatal(3, only_root_writes = .true., namespace=namespace)
978
979 end if
980
981 end subroutine messages_variable_is_block
983 ! ---------------------------------------------------------
984 subroutine messages_experimental(name, namespace)
985 character(len=*), intent(in) :: name
986 type(namespace_t), optional, intent(in) :: namespace
987
988 experimentals = experimentals + 1
989
990 if (.not. conf%devel_version) then
991 call messages_write(trim(name)//' is an experimental feature.')
992 call messages_new_line()
993 call messages_new_line()
994 call messages_write('If you still want to use this feature (at your own risk), check:')
995 call messages_new_line()
996 call messages_new_line()
997 call messages_write('https://www.octopus-code.org/documentation/main/variables/execution/debug/experimentalfeatures')
998 call messages_new_line()
999 call messages_fatal(only_root_writes = .true., namespace=namespace)
1000 else
1001 write(message(1), '(a)') trim(name)//' is under development.'
1002 write(message(2), '(a)') 'It might not work or produce wrong results.'
1003 call messages_warning(2, namespace=namespace)
1004
1005 ! remove this warning from the count
1006 warnings = warnings - 1
1007 end if
1008
1009 end subroutine messages_experimental
1010
1011 ! ------------------------------------------------------------
1012 subroutine messages_not_implemented(feature, namespace)
1013 character(len=*), intent(in) :: feature
1014 type(namespace_t), optional, intent(in) :: namespace
1015
1016 push_sub(messages_not_implemented)
1017
1018 message(1) = trim(feature)//" not implemented."
1019 call messages_fatal(1, only_root_writes = .true., namespace=namespace)
1020
1023
1024 ! ------------------------------------------------------------
1025 subroutine messages_reset_lines()
1026
1027 current_line = 1
1028 message(1) = ''
1029
1030 end subroutine messages_reset_lines
1031
1032 ! ------------------------------------------------------------
1033 subroutine messages_new_line()
1034
1035 current_line = current_line + 1
1036 message(current_line) = ''
1037
1038 if (current_line > max_lines) stop 'Too many message lines.'
1039
1040 end subroutine messages_new_line
1041
1042 ! ------------------------------------------------------------
1043 subroutine messages_write_float(val, fmt, new_line, units, align_left, print_units)
1044 real(real64), intent(in) :: val
1045 character(len=*), optional, intent(in) :: fmt
1046 logical, optional, intent(in) :: new_line
1047 type(unit_t), optional, intent(in) :: units
1048 logical, optional, intent(in) :: align_left
1049 logical, optional, intent(in) :: print_units
1050
1051 character(len=30) :: number
1052 real(real64) :: tval
1053
1054 tval = val
1055 if (present(units)) tval = units_from_atomic(units, val)
1056
1057 if (present(fmt)) then
1058 write(number, '('//trim(fmt)//')') tval
1059 else
1060 write(number, '(f12.6)') tval
1061 end if
1063 if (optional_default(align_left, .false.)) then
1064 number = adjustl(number)
1065 number(1:len(number)) = ' '//number(1:len(number)-1)
1066 end if
1067
1068 write(message(current_line), '(a, a)') trim(message(current_line)), trim(number)
1069
1070 if (present(units) .and. optional_default(print_units, .true.)) then
1071 write(message(current_line), '(a, a, a)') trim(message(current_line)), ' ', trim(units_abbrev(units))
1072 end if
1073
1074 if (optional_default(new_line, .false.)) call messages_new_line()
1075
1076 end subroutine messages_write_float
1077
1078 ! ------------------------------------------------------------
1079 subroutine messages_write_integer8(val, fmt, new_line, units, print_units)
1080 integer(int64), intent(in) :: val
1081 character(len=*), optional, intent(in) :: fmt
1082 logical, optional, intent(in) :: new_line
1083 type(unit_t), optional, intent(in) :: units
1084 logical, optional, intent(in) :: print_units
1085
1086 character(len=20) :: number
1087 real(real64) :: val_conv_float
1088
1089 if (present(units)) then
1090 val_conv_float = units_from_atomic(units, dble(val))
1091
1092 if (present(fmt)) then
1093 write(message(current_line), '(a, '//trim(fmt)//')') trim(message(current_line)), val_conv_float
1094 else
1095 write(number, '(f15.3)') val_conv_float
1096 write(message(current_line), '(3a)') trim(message(current_line)), ' ', trim(adjustl(number))
1097 end if
1098
1099 else
1100
1101 if (present(fmt)) then
1102 write(message(current_line), '(a, '//trim(fmt)//')') trim(message(current_line)), val
1103 else
1104 write(number, '(i12)') val
1105 write(message(current_line), '(3a)') trim(message(current_line)), ' ', trim(adjustl(number))
1106 end if
1107
1108 end if
1109
1110
1111 if (present(units) .and. optional_default(print_units, .true.)) then
1112 write(message(current_line), '(a, a, a)') trim(message(current_line)), ' ', trim(adjustl(units_abbrev(units)))
1113 end if
1114
1115 if (present(new_line)) then
1116 if (new_line) call messages_new_line()
1117 end if
1118
1119 end subroutine messages_write_integer8
1120
1121 ! ------------------------------------------------------------
1122 subroutine messages_write_integer(val, fmt, new_line, units, print_units)
1123 integer(int32), intent(in) :: val
1124 character(len=*), optional, intent(in) :: fmt
1125 logical, optional, intent(in) :: new_line
1126 type(unit_t), optional, intent(in) :: units
1127 logical, optional, intent(in) :: print_units
1128
1129 call messages_write_integer8(int(val, int64), fmt, new_line, units, print_units)
1130
1131 end subroutine messages_write_integer
1132
1133 ! ------------------------------------------------------------
1134 subroutine messages_write_str(val, fmt, new_line)
1135 character(len=*), intent(in) :: val
1136 character(len=*), optional, intent(in) :: fmt
1137 logical, optional, intent(in) :: new_line
1138
1139 character(len=100) :: fmt_
1140
1141 if (len(trim(message(current_line))) + len(trim(val)) > len(message(current_line))) then
1142 ! cannot use normal message approach without interfering with message we are trying to write
1143 ! write directly in case trim(val) is itself too long
1144 write(0, *) "Exceeded message line length limit, to write string:", trim(val)
1145 else
1146 fmt_ = optional_default(fmt, '(a)')
1147 write(message(current_line), '(a, '//trim(fmt_)//')') trim(message(current_line)), trim(val)
1148 end if
1149
1150 if (present(new_line)) then
1151 if (new_line) call messages_new_line()
1152 end if
1153
1154 end subroutine messages_write_str
1155
1156 ! ------------------------------------------------------------
1157 subroutine messages_write_logical(val, new_line)
1158 logical, intent(in) :: val
1159 logical, optional, intent(in) :: new_line
1160
1161 character(len=3) :: text
1162
1163 if (val) then
1164 text = 'yes'
1165 else
1166 text = 'no'
1167 end if
1168
1169 if (len(trim(message(current_line))) + len(trim(text)) > len(message(current_line))) then
1170 write(message(current_line + 1), '(3a)') "Exceeded message line length limit, to write logical value '", trim(text), "'"
1171 call messages_fatal(current_line + 1)
1172 end if
1173
1174 write(message(current_line), '(a,1x,a)') trim(message(current_line)), trim(text)
1175
1176 if (present(new_line)) then
1177 if (new_line) call messages_new_line()
1178 end if
1179
1180 end subroutine messages_write_logical
1181
1182 ! -----------------------------------------------------------
1183 subroutine messages_dump_stack(isignal)
1184 integer, intent(in) :: isignal
1185
1186 integer :: ii
1187 character(len=300) :: description
1188 character(kind=c_char) :: cstr(301)
1189
1190 interface get_signal_description
1191 subroutine get_signal_description(signum, signame) bind(c)
1192 use iso_c_binding
1193 implicit none
1194 integer, intent(in) :: signum
1195 character(kind=c_char), intent(out) :: signame(*)
1196 end subroutine get_signal_description
1197 end interface get_signal_description
1198
1199 cstr = c_null_char
1200 call get_signal_description(isignal, cstr)
1201 call string_c_to_f(cstr, description)
1202
1203 write(msg, '(a,i2)') ''
1204 call flush_msg(msg, stderr)
1205 write(msg, '(a,i2)') '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%'
1206 call flush_msg(msg, stderr)
1207 write(msg, '(a,i2)') ''
1208 call flush_msg(msg, stderr)
1209 write(msg, '(a,i2,2a)') ' Octopus was killed by signal ', isignal, ': ', trim(description)
1210 call flush_msg(msg, stderr)
1211 write(msg, '(a,i2)') ''
1212 call flush_msg(msg, stderr)
1213 write(msg, '(a)') ' Note: Octopus is currently trapping signals. This might prevent the'
1214 call flush_msg(msg, stderr)
1215 write(msg, '(a)') ' use of debuggers or the generation of core dumps. To change this'
1216 call flush_msg(msg, stderr)
1217 write(msg, '(a)') ' behavior, use the DebugTrapSignals input option.'
1218 call flush_msg(msg, stderr)
1219 write(msg, '(a,i2)') ''
1220 call flush_msg(msg, stderr)
1221 write(msg, '(a,i2)') '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%'
1222 call flush_msg(msg, stderr)
1223
1224 if (debug%trace) then
1225 call flush_msg(shyphens, iunit=stderr)
1226
1227 write(msg, '(a)') 'Octopus debug trace: '
1228 call flush_msg(msg, stderr)
1229 do ii = 1, no_sub_stack
1230 write(msg, '(a,a)') ' > ', trim(sub_stack(ii))
1231 call flush_msg(msg, stderr, adv='no')
1232 end do
1233 call flush_msg(" ", stderr)
1234 else
1235 write(msg, '(a)') " Octopus debug trace not available. You can enable it with 'Debug = trace'."
1236 call flush_msg(msg, stderr)
1237 end if
1238
1239 end subroutine messages_dump_stack
1240
1241end module messages_oct_m
1242
1243! ---------------------------------------------------------
1247subroutine assert_die(s, f, l)
1248 use debug_oct_m
1249 use messages_oct_m
1250 use mpi_oct_m
1251
1252 implicit none
1253
1254 character(len=*), intent(in) :: s, f
1255 integer, intent(in) :: l
1256
1257 call messages_write('Node ')
1258 call messages_write(mpi_world%rank)
1259 call messages_write(':')
1260 call messages_new_line()
1262 call messages_write(' Assertion "'//trim(s)//'"')
1263 call messages_new_line()
1264
1265 call messages_write(' failed in line ')
1266 call messages_write(l)
1267 call messages_write(' of file "'//trim(debug_clean_path(f))//'".')
1268 call messages_new_line()
1269
1270 call messages_write('This should not happen and is likely a bug in the code.')
1271 call messages_new_line()
1272 call messages_write('Please contact the developers and report how this occurred.')
1273 call messages_new_line()
1274 call messages_write('You can open an issue on gitlab as described in Contributing.md.')
1275 call messages_new_line()
1276
1277 call messages_fatal()
1278
1279end subroutine assert_die
1280
1281!-------------------------------------------------------
1282subroutine handle_segv(isignal) bind(c)
1283 use messages_oct_m
1284 use iso_c_binding
1285
1286 implicit none
1287
1288 integer(c_int), intent(in) :: isignal
1289
1290 ! Switch status to aborted
1291 call messages_switch_status('aborted')
1292
1293 ! Dump stack
1294 call messages_dump_stack(isignal)
1295
1296end subroutine handle_segv
1297
1298
1299!! Local Variables:
1300!! mode: f90
1301!! coding: utf-8
1302!! End:
Prints out to iunit a message in the form: ["InputVariable" = value] where "InputVariable" is given b...
Definition: messages.F90:182
subroutine handle_segv(isignal)
Definition: messages.F90:1361
subroutine assert_die(s, f, l)
This subroutine is called by the assert macro, it is not in a module so it can be called from any fil...
Definition: messages.F90:1326
character(len=max_path_len) function, public debug_clean_path(filename)
Prune a filename path to only include subdirectories of the "src" directory.
Definition: debug.F90:593
type(debug_t), save, public debug
Definition: debug.F90:158
subroutine, public debug_init(this, namespace)
Definition: debug.F90:180
integer, public no_sub_stack
Definition: global.F90:254
character(len=80), dimension(50), public sub_stack
The stack.
Definition: global.F90:252
type(conf_t), public conf
Global instance of Octopus configuration.
Definition: global.F90:181
Definition: io.F90:116
subroutine, public io_close(iunit, grp)
Definition: io.F90:466
subroutine, public io_mkdir(fname, namespace, parents)
Definition: io.F90:360
integer, parameter, public iunit_out
Definition: io.F90:151
integer, parameter, public iunit_err
Definition: io.F90:152
integer function, public io_open(file, namespace, action, status, form, position, die, recl, grp)
Definition: io.F90:401
subroutine, public loct_rm(name)
Definition: loct.F90:309
subroutine string_c_to_f(c_string, f_string)
convert a C string to a Fortran string
Definition: loct.F90:262
subroutine, public alloc_error(size, file, line)
Definition: messages.F90:669
subroutine, public messages_end()
Definition: messages.F90:273
subroutine messages_write_integer8(val, fmt, new_line, units, print_units)
Definition: messages.F90:1158
subroutine, public messages_print_with_emphasis(msg, iunit, namespace)
Definition: messages.F90:898
subroutine, public messages_not_implemented(feature, namespace)
Definition: messages.F90:1091
subroutine, public messages_init(output_dir)
Definition: messages.F90:220
subroutine messages_print_var_option_8(var, option, pre, iunit, namespace)
Definition: messages.F90:857
subroutine messages_print_var_valuear(var, val, unit, iunit, namespace)
Definition: messages.F90:804
subroutine, public messages_variable_is_block(namespace, name)
Definition: messages.F90:1047
subroutine, public messages_warning(no_lines, all_nodes, namespace)
Definition: messages.F90:525
subroutine messages_write_integer(val, fmt, new_line, units, print_units)
Definition: messages.F90:1201
subroutine, public time_sum(sec1, usec1, sec2, usec2)
Computes t2 <- t1+t2. Parameters as in time_diff Assert: t1,2 <= 0.
Definition: messages.F90:1002
subroutine messages_print_var_option_4(var, option, pre, iunit, namespace)
Definition: messages.F90:884
subroutine, public messages_obsolete_variable(namespace, name, rep)
Definition: messages.F90:1023
subroutine, public messages_switch_status(status)
create status file for asynchronous communication
Definition: messages.F90:645
subroutine, public print_date(str)
Definition: messages.F90:983
subroutine flush_msg(str, iunit, adv)
Definition: messages.F90:968
subroutine, public messages_print_var_info(var, iunit, namespace)
Definition: messages.F90:833
subroutine, public messages_update_mpi_grp(namespace, mpigrp)
Definition: messages.F90:367
subroutine, public messages_new_line()
Definition: messages.F90:1112
subroutine, public dealloc_error(size, file, line)
Definition: messages.F90:680
subroutine messages_print_var_values(var, val, iunit, namespace)
Definition: messages.F90:746
subroutine, public messages_fatal(no_lines, only_root_writes, namespace)
Definition: messages.F90:410
subroutine messages_print_var_valuei(var, val, iunit, namespace)
Definition: messages.F90:729
subroutine, public messages_input_error(namespace, var, details, row, column)
Definition: messages.F90:691
subroutine messages_print_var_valuer(var, val, unit, iunit, namespace)
Definition: messages.F90:760
integer, parameter, private sleepytime_nonwriters
seconds
Definition: messages.F90:168
subroutine, public messages_experimental(name, namespace)
Definition: messages.F90:1063
subroutine messages_print_var_valuel(var, val, iunit, namespace)
Definition: messages.F90:783
subroutine messages_write_logical(val, new_line)
Definition: messages.F90:1236
subroutine, public messages_info(no_lines, iunit, debug_only, stress, all_nodes, namespace)
Definition: messages.F90:594
subroutine messages_write_str(val, fmt, new_line)
Definition: messages.F90:1213
type(mpi_grp_t) function messages_get_mpi_grp(namespace)
Definition: messages.F90:378
subroutine, public messages_dump_stack(isignal)
Definition: messages.F90:1262
integer function messages_get_unit(namespace)
Definition: messages.F90:340
subroutine messages_write_float(val, fmt, new_line, units, align_left, print_units)
Definition: messages.F90:1122
subroutine messages_reset_lines()
Definition: messages.F90:1104
type(mpi_grp_t), public mpi_world
Definition: mpi.F90:272
type(namespace_t), public global_namespace
Definition: namespace.F90:134
logical function, public parse_is_defined(namespace, name)
Definition: parser.F90:455
This module implements a simple hash table for string valued keys and integer values using the C++ ST...
Definition: sihash.F90:120
subroutine, public sihash_insert(h, key, val)
Insert a (key, val) pair into the hash table h.
Definition: sihash.F90:205
subroutine, public sihash_init(h)
Initialize a hash table h with size entries. Since we use separate chaining, the number of entries in...
Definition: sihash.F90:164
integer function, public sihash_lookup(h, key, found)
Look up a value in the hash table h. If found is present, it indicates if key could be found in the t...
Definition: sihash.F90:231
subroutine, public sihash_end(h)
Free a hash table.
Definition: sihash.F90:185
This module implements a simple hash table for string valued keys and integer values using the C++ ST...
Definition: sphash.F90:120
subroutine, public sphash_init(h)
Initialize a hash table h with size entries. Since we use separate chaining, the number of entries in...
Definition: sphash.F90:224
subroutine, public sphash_insert(h, key, val, clone)
Insert a (key, val) pair into the hash table h. If clone=.true., the object will be copied.
Definition: sphash.F90:293
subroutine, public sphash_end(h)
Free a hash table.
Definition: sphash.F90:250
class(*) function, pointer, public sphash_lookup(h, key, found)
Look up a value in the hash table h. If found is present, it indicates if key could be found in the t...
Definition: sphash.F90:325
character(len=80) function, public str_center(s_in, l_in)
puts space around string, so that it is centered
Definition: string.F90:199
brief This module defines the class unit_t which is used by the unit_systems_oct_m module.
Definition: unit.F90:134
character(len=20) pure function, public units_abbrev(this)
Definition: unit.F90:225
subroutine, public varinfo_print_option(iunit, var, option, pre)
Definition: varinfo.F90:312
subroutine, public varinfo_print(iunit, var, ierr)
Definition: varinfo.F90:207
void get_signal_description(fint *signum, char *signame)
Definition: signals.c:3776
This is defined even when running serial.
Definition: mpi.F90:144
int true(void)
real(real64) function values(xx)
Definition: test.F90:2025