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