1!! Copyright (C) 2002-20016 M. Marques, A. Castro, A. Rubio, G. Bertsch, X. Andrade 2!! 3!! This program is free software; you can redistribute it and/or modify 4!! it under the terms of the GNU General Public License as published by 5!! the Free Software Foundation; either version 2, or (at your option) 6!! any later version. 7!! 8!! This program is distributed in the hope that it will be useful, 9!! but WITHOUT ANY WARRANTY; without even the implied warranty of 10!! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11!! GNU General Public License for more details. 12!! 13!! You should have received a copy of the GNU General Public License 14!! along with this program; if not, write to the Free Software 15!! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 16!! 02110-1301, USA. 17!! 18 19#include "global.h" 20 21module messages_oct_m 22 use global_oct_m 23 use debug_oct_m 24 use loct_oct_m 25 use mpi_oct_m 26 use namespace_oct_m 27 use parser_oct_m 28 use string_oct_m 29 use unit_oct_m 30 use varinfo_oct_m 31 32 implicit none 33 34 private 35 36 public :: & 37 messages_init, & 38 messages_end, & 39 messages_fatal, & 40 messages_warning, & 41 messages_info, & 42 messages_debug, & 43 messages_debug_marker, & 44 messages_debug_newlines, & 45 messages_switch_status, & 46 delete_debug_trace, & 47 print_date, & 48 time_diff, & 49 time_sum, & 50 epoch_time_diff, & 51 alloc_error, & 52 dealloc_error, & 53 messages_input_error, & 54 push_sub, & 55 pop_sub, & 56 messages_print_stress, & 57 messages_print_var_info, & 58 messages_print_var_option, & 59 messages_print_var_value, & 60 messages_obsolete_variable, & 61 messages_experimental, & 62 messages_check_def, & 63 messages_not_implemented, & 64 messages_new_line, & 65 messages_write, & 66 messages_clean_path, & 67 messages_dump_stack, & 68 debug 69 70 integer, parameter :: max_lines = 20 71 character(len=256), dimension(max_lines), public :: message !< to be output by fatal, warning 72 character(len=68), parameter, public :: hyphens = & 73 '--------------------------------------------------------------------' 74 character(len=69), parameter, public :: shyphens = '*'//hyphens 75 76 logical, public :: flush_messages 77 78 79 !> min_lun in io.F90 is equal to 10. We hardwire this here since we 80 !! cannot write "use io" above. Unit 8 and 9 should always be available. 81 integer, parameter, public :: iunit_out = 8 82 integer, parameter, public :: iunit_err = 9 83 !> max_lun is currently 99, i.e. we can hardwire unit_offset above 1000 84 integer, parameter, private :: unit_offset = 1000 85 character(len=512), private :: msg 86 integer, parameter, private :: SLEEPYTIME_ALL = 1, SLEEPYTIME_NONWRITERS = 60 !< seconds 87 88 89 ! --------------------------------------------------------- 90 !> Prints out to iunit a message in the form: 91 !! ["InputVariable" = value] 92 !! where "InputVariable" is given by var. 93 !! Since the variable can be integer, real, logical, or string we 94 !! need a generic interface. 95 ! --------------------------------------------------------- 96 interface messages_print_var_value 97 module procedure messages_print_var_valuei 98 module procedure messages_print_var_values 99 module procedure messages_print_var_valuer 100 module procedure messages_print_var_valuel 101 module procedure messages_print_var_valuear 102 end interface messages_print_var_value 103 104 interface messages_write 105 module procedure messages_write_float 106 module procedure messages_write_integer 107 module procedure messages_write_integer8 108 module procedure messages_write_str 109 module procedure messages_write_logical 110 end interface messages_write 111 112 113 interface messages_print_var_option 114 module procedure messages_print_var_option_4 115 module procedure messages_print_var_option_8 116 end interface messages_print_var_option 117 118 integer :: warnings 119 integer :: experimentals 120 integer :: current_line 121 122 type(debug_t), save :: debug 123 124 !> from signals.c 125 interface 126 subroutine get_signal_description(signum, signame) 127 implicit none 128 integer, intent(in) :: signum 129 character(len=*), intent(out) :: signame 130 end subroutine get_signal_description 131 132 subroutine trap_segfault() 133 implicit none 134 end subroutine trap_segfault 135 end interface 136 137 138 139contains 140 141 ! --------------------------------------------------------- 142 subroutine messages_init() 143 144 logical :: trap_signals 145 146 call messages_obsolete_variable(global_namespace, 'DevelVersion', 'ExperimentalFeatures') 147 148 !%Variable ExperimentalFeatures 149 !%Type logical 150 !%Default no 151 !%Section Execution::Debug 152 !%Description 153 !% If true, allows the use of certain parts of the code that are 154 !% still under development and are not suitable for production 155 !% runs. This should not be used unless you know what you are doing. 156 !% See details on 157 !% <a href=http://octopus-code.org/experimental_features>wiki page</a>. 158 !%End 159 call parse_variable(global_namespace, 'ExperimentalFeatures', .false., conf%devel_version) 160 161 call messages_obsolete_variable(global_namespace, 'DebugLevel', 'Debug') 162 163 call debug_init(debug, global_namespace) 164 165 warnings = 0 166 experimentals = 0 167 168 !%Variable DebugTrapSignals 169 !%Type logical 170 !%Section Execution::Debug 171 !%Description 172 !% If true, trap signals to handle them in octopus itself and 173 !% print a custom backtrace. If false, do not trap signals; then, 174 !% core dumps can be produced or gdb can be used to stop at the 175 !% point a signal was produced (e.g. a segmentation fault). This 176 !% variable is enabled if <tt>Debug</tt> is set to trace mode 177 !% (<tt>trace</tt>, <tt>trace_term</tt> or <tt>trace_file</tt>). 178 !%End 179 call parse_variable(global_namespace, 'DebugTrapSignals', debug%trace, trap_signals) 180 181 if (trap_signals) call trap_segfault() 182 183 call messages_reset_lines() 184 185 end subroutine messages_init 186 187 ! --------------------------------------------------------- 188 189 subroutine messages_end() 190 191 if(mpi_grp_is_root(mpi_world)) then 192 193 if(experimentals > 0 .or. warnings > 0) then 194 message(1) = '' 195 call messages_info(1) 196 end if 197 198 199 if(warnings > 0) then 200 call messages_write('Octopus emitted ') 201 call messages_write(warnings) 202 if(warnings > 1) then 203 call messages_write(' warnings.') 204 else 205 call messages_write(' warning.') 206 end if 207 call messages_info() 208 end if 209 210 if(experimentals > 0) then 211 call messages_new_line() 212 call messages_write('Octopus used ') 213 call messages_write(experimentals) 214 if(experimentals > 1) then 215 call messages_write(' experimental features:') 216 else 217 call messages_write(' experimental feature:') 218 end if 219 call messages_new_line() 220 call messages_new_line() 221 call messages_write(' Since you used one or more experimental features, results are likely') 222 call messages_new_line() 223 call messages_write(' wrong and should not be considered as valid scientific data. Check') 224 call messages_new_line() 225 call messages_new_line() 226 call messages_write(' http://octopus-code.org/experimental_features') 227 call messages_new_line() 228 call messages_new_line() 229 call messages_write(' or contact the octopus developers for details.') 230 call messages_new_line() 231 call messages_info() 232 end if 233 234 open(unit = iunit_out, file = 'exec/messages', action = 'write') 235 write(iunit_out, '(a, i9)') "warnings = ", warnings 236 write(iunit_out, '(a, i9)') "experimental = ", experimentals 237 close(iunit_out) 238 239 end if 240 241 end subroutine messages_end 242 243 ! --------------------------------------------------------- 244 subroutine messages_fatal(no_lines, only_root_writes, namespace) 245 integer, optional, intent(in) :: no_lines 246 logical, optional, intent(in) :: only_root_writes 247 type(namespace_t), optional, intent(in) :: namespace 248 249 integer :: ii, no_lines_ 250 logical :: only_root_writes_, should_write 251 integer, allocatable :: recv_buf(:), recv_req(:) 252#ifdef HAVE_MPI 253 integer, parameter :: FATAL_TAG = 1620299 254 logical :: received 255 integer :: send_req 256#endif 257 258 no_lines_ = current_line 259 if(present(no_lines)) no_lines_ = no_lines 260 261 if(present(only_root_writes)) then 262 should_write = mpi_grp_is_root(mpi_world) .or. (.not. only_root_writes) 263 only_root_writes_ = only_root_writes 264 else 265 should_write = .true. 266 only_root_writes_ = .false. 267 end if 268 269 ! This is to avoid all nodes reporting an error. The root node 270 ! post a message reception to all nodes, the rest of the nodes 271 ! send a message. If the message is received, the non-root nodes 272 ! know that the root node will report the error, so they do not do 273 ! anything. 274 275 if(.not. only_root_writes_) then 276 if(mpi_world%rank == 0) then 277 278 allocate(recv_buf(1:mpi_world%size - 1)) 279 allocate(recv_req(1:mpi_world%size - 1)) 280 do ii = 1, mpi_world%size - 1 281#ifdef HAVE_MPI 282 call MPI_Recv_init(recv_buf(ii), 1, MPI_INTEGER, ii, FATAL_TAG, mpi_world%comm, recv_req(ii), mpi_err) 283#endif 284 end do 285 deallocate(recv_buf) 286 deallocate(recv_req) 287 288 else 289 290#ifdef HAVE_MPI 291 call MPI_Send_init(1, 1, MPI_INTEGER, 0, FATAL_TAG, mpi_world%comm, send_req, mpi_err) 292#endif 293 !sleep for a second and check 294 call loct_nanosleep(SLEEPYTIME_ALL, 0) 295#ifdef HAVE_MPI 296 call MPI_Test(send_req, received, MPI_STATUS_IGNORE, mpi_err) 297#endif 298 should_write = .false. 299 300 end if 301 end if 302 303 if(flush_messages .and. mpi_grp_is_root(mpi_world)) then 304 open(unit=iunit_err, file='messages.stderr', & 305 action='write', position='append') 306 end if 307 308 ! Give a moment for all standard output hopefully to be printed 309 call loct_nanosleep(SLEEPYTIME_ALL, 0) 310 311 ! If we are not writing wait for the root node to get here and 312 ! write the error message. If the root doesn`t get here, we all print the 313 ! error messsage anyways and die. Otherwise, no message might be written. 314 if(.not. should_write) call loct_nanosleep(SLEEPYTIME_NONWRITERS, 0) 315 316 call messages_print_stress(stderr, "FATAL ERROR") 317 write(msg, '(a)') '*** Fatal Error (description follows)' 318 call flush_msg(stderr, msg) 319 320 if(present(namespace)) then 321 if(len_trim(namespace%get()) > 0) then 322 write(msg, '(3a)') '* In namespace ', trim(namespace%get()), ':' 323 call flush_msg(stderr, msg) 324 end if 325 end if 326 327#ifdef HAVE_MPI 328 if(.not. only_root_writes_ .or. .not. mpi_grp_is_root(mpi_world)) then 329 call flush_msg(stderr, shyphens) 330 write(msg, '(a,i4)') "* From node = ", mpi_world%rank 331 call flush_msg(stderr, msg) 332 end if 333#endif 334 call flush_msg(stderr, shyphens) 335 do ii = 1, no_lines_ 336 write(msg, '(a,1x,a)') '*', trim(message(ii)) 337 call flush_msg(stderr, msg) 338 end do 339 340 ! We only dump the stack in debug mode because subroutine invocations 341 ! are only recorded in debug mode (via push_sub/pop_sub). Otherwise, 342 ! it is a bit confusing that the stack seems to be empty. 343 if(debug%trace) then 344 call flush_msg(stderr, shyphens) 345 346 write(msg, '(a)') '* Stack: ' 347 call flush_msg(stderr, msg, 'no') 348 do ii = 1, no_sub_stack 349 write(msg, '(a,a)') ' > ', trim(sub_stack(ii)) 350 call flush_msg(stderr, msg, 'no') 351 end do 352 call flush_msg(stderr, " ") 353 end if 354 355 if(should_write) then 356 call messages_print_stress(stderr) 357 end if 358 359 if(flush_messages .and. mpi_grp_is_root(mpi_world)) then 360 close(iunit_err) 361 end if 362 363 ! switch file indicator to state aborted 364 call messages_switch_status('aborted') 365 366#ifdef HAVE_MPI 367 call MPI_Abort(mpi_world%comm, 999, mpi_err) 368#endif 369 370 call loct_exit_failure() 371 end subroutine messages_fatal 372 373 374 ! --------------------------------------------------------- 375 subroutine messages_warning(no_lines, all_nodes, namespace) 376 integer, optional, intent(in) :: no_lines 377 logical, optional, intent(in) :: all_nodes 378 type(namespace_t), optional, intent(in) :: namespace 379 380 integer :: il, no_lines_ 381 logical :: have_to_write, all_nodes_ 382 383 no_lines_ = current_line 384 if(present(no_lines)) no_lines_ = no_lines 385 386 INCR(warnings, 1) 387 388 have_to_write = mpi_grp_is_root(mpi_world) 389 390 all_nodes_ = .false. 391 if(present(all_nodes)) then 392 have_to_write = have_to_write .or. all_nodes 393 all_nodes_ = all_nodes 394 end if 395 396 if(have_to_write) then 397 398 if(flush_messages) open(unit=iunit_err, file='messages.stderr', action='write', position='append') 399 400 call flush_msg(stderr, '') 401 write(msg, '(a)') '** Warning:' 402 call flush_msg(stderr, msg) 403 404 if(present(namespace)) then 405 if(len_trim(namespace%get()) > 0) then 406 write(msg, '(3a)') '** In namespace ', trim(namespace%get()), ':' 407 call flush_msg(stderr, msg) 408 end if 409 end if 410 411#ifdef HAVE_MPI 412 if(all_nodes_) then 413 write(msg , '(a,i4)') '** From node = ', mpi_world%rank 414 call flush_msg(stderr, msg) 415 end if 416#endif 417 418 do il = 1, no_lines_ 419 write(msg , '(a,3x,a)') '**', trim(message(il)) 420 call flush_msg(stderr, msg) 421 end do 422 call flush_msg(stderr, '') 423 424#ifdef HAVE_FLUSH 425 call flush(stderr) 426#endif 427 428 if(flush_messages) close(iunit_err) 429 430 end if 431 432 call messages_reset_lines() 433 434 end subroutine messages_warning 435 436 ! --------------------------------------------------------- 437 438 subroutine messages_info(no_lines, iunit, verbose_limit, stress, all_nodes) 439 integer, optional, intent(in) :: no_lines 440 integer, optional, intent(in) :: iunit 441 logical, optional, intent(in) :: verbose_limit 442 logical, optional, intent(in) :: stress 443 logical, optional, intent(in) :: all_nodes 444 445 integer :: il, iu, no_lines_ 446 447 if(.not. mpi_grp_is_root(mpi_world) .and. .not. optional_default(all_nodes, .false.)) then 448 call messages_reset_lines() 449 return 450 end if 451 452 no_lines_ = current_line 453 if(present(no_lines)) no_lines_ = no_lines 454 455 if(flush_messages) then 456 open(unit=iunit_out, file='messages.stdout', & 457 action='write', position='append') 458 end if 459 460 if(present(iunit)) then 461 iu = iunit 462 else 463 iu = stdout 464 end if 465 466 if(present(stress)) then 467 call messages_print_stress(iu) 468 end if 469 470 do il = 1, no_lines_ 471 if(.not. present(verbose_limit) .or. debug%info) then 472 write(msg, '(a)') trim(message(il)) 473 call flush_msg(iu, msg) 474 end if 475 end do 476 if(present(stress)) then 477 call messages_print_stress(iu) 478 end if 479 480 if(flush_messages) close(iunit_out) 481 482#ifdef HAVE_FLUSH 483 call flush(iu) 484#endif 485 486 call messages_reset_lines() 487 488 end subroutine messages_info 489 490 491 ! --------------------------------------------------------- 492 subroutine messages_debug(no_lines) 493 integer, intent(in) :: no_lines 494 495 integer :: il, iunit 496 497 if(.not. debug%info) return 498 499 if(flush_messages .and. mpi_grp_is_root(mpi_world)) then 500 open(unit=iunit_out, file='messages.stdout', & 501 action='write', position='append') 502 end if 503 504 call open_debug_trace(iunit) 505 do il = 1, no_lines 506 write(msg, '(a)') trim(message(il)) 507 call flush_msg(iunit, msg) 508 end do 509 close(iunit) 510 511 if(flush_messages .and. mpi_grp_is_root(mpi_world)) then 512 close(iunit_out) 513 end if 514 515 end subroutine messages_debug 516 517 518 ! --------------------------------------------------------- 519 subroutine messages_debug_newlines(no_lines) 520 integer, intent(in) :: no_lines 521 522 integer :: il, iunit 523 524 if(.not. debug%info) return 525 if(mpi_grp_is_root(mpi_world)) return 526 527 if(flush_messages) then 528 open(unit=iunit_out, file='messages.stdout', & 529 action='write', position='append') 530 end if 531 532 call open_debug_trace(iunit) 533 do il = 1, no_lines 534 write(msg, '(a)') '* -' 535 call flush_msg(iunit, msg) 536 end do 537 close(iunit) 538 539 if(flush_messages) close(iunit_out) 540 541 end subroutine messages_debug_newlines 542 543 544 ! --------------------------------------------------------- 545 subroutine messages_debug_marker(no) 546 integer, intent(in) :: no 547 548 if(.not. debug%info) return 549 550 write(message(1), '(a,i3)') 'debug marker #', no 551 call messages_debug(1) 552 553 end subroutine messages_debug_marker 554 555 556 ! --------------------------------------------------------- 557 !> create status file for asynchronous communication 558 subroutine messages_switch_status(status) 559 character(len=*), intent(in) :: status 560 561 ! only root node is taking care of file I/O 562 if (.not.mpi_grp_is_root(mpi_world)) return 563 564 ! remove old status files first, before we switch to state aborted 565 call loct_rm('exec/oct-status-running') 566 call loct_rm('exec/oct-status-finished') 567 call loct_rm('exec/oct-status-aborted') 568 569 ! create empty status file to indicate 'aborted state' 570 open(unit=iunit_err, file='exec/oct-status-'//trim(status), & 571 action='write', status='unknown') 572 close(iunit_err) 573 574 end subroutine messages_switch_status 575 576 577 ! --------------------------------------------------------- 578 subroutine open_debug_trace(iunit) 579 integer, intent(out) :: iunit 580 581 character(len=6) :: filenum 582 583 iunit = mpi_world%rank + unit_offset 584 write(filenum, '(i6.6)') iunit - unit_offset 585 call loct_mkdir('debug') 586 open(iunit, file = 'debug/debug_trace.node.'//filenum, & 587 action='write', status='unknown', position='append') 588 589 end subroutine open_debug_trace 590 591 ! --------------------------------------------------------- 592 subroutine delete_debug_trace() 593 594 integer :: iunit 595 character(len=6) :: filenum 596 597 iunit = mpi_world%rank + unit_offset 598 write(filenum, '(i6.6)') iunit - unit_offset 599 call loct_mkdir('debug') 600 call loct_rm('debug/debug_trace.node.'//filenum) 601 602 end subroutine delete_debug_trace 603 604 605 ! --------------------------------------------------------- 606 subroutine alloc_error(size, file, line) 607 integer(8), intent(in) :: size 608 character(len=*), intent(in) :: file 609 integer, intent(in) :: line 610 611 write(message(1), '(a,i18,3a,i5)') "Failed to allocate ", size, " words in file '", trim(file), "' line ", line 612 call messages_fatal(1) 613 614 end subroutine alloc_error 615 616 617 ! --------------------------------------------------------- 618 subroutine dealloc_error(size, file, line) 619 integer(8), intent(in) :: size 620 character(len=*), intent(in) :: file 621 integer, intent(in) :: line 622 623 write(message(1), '(a,i18,3a,i5)') "Failed to deallocate array of ", size, " words in file '", trim(file), "' line ", line 624 call messages_fatal(1) 625 626 end subroutine dealloc_error 627 628 629 ! --------------------------------------------------------- 630 subroutine messages_input_error(namespace, var, details) 631 type(namespace_t), intent(in) :: namespace 632 character(len=*), intent(in) :: var 633 character(len=*), optional, intent(in) :: details 634 635 call messages_write('Input error in the input variable '// trim(var)) 636 637 if(present(details)) then 638 call messages_write(':', new_line = .true.) 639 call messages_new_line() 640 call messages_write(' '//trim(details)//'.', new_line = .true.) 641 else 642 call messages_write('.', new_line = .true.) 643 end if 644 645 call messages_new_line() 646 647 call messages_write('You can get the documentation of the variable with the command:', new_line = .true.) 648 call messages_write(' oct-help -p '//trim(var)) 649 call messages_fatal(namespace=namespace) 650 651 end subroutine messages_input_error 652 ! --------------------------------------------------------- 653 654 655 ! --------------------------------------------------------- 656 subroutine messages_print_var_valuei(iunit, var, val) 657 integer, intent(in) :: iunit 658 character(len=*), intent(in) :: var 659 integer, intent(in) :: val 660 661 character(len=10) :: intstring 662 663 if(.not. mpi_grp_is_root(mpi_world)) return 664 665 write(intstring,'(i10)') val 666 write(iunit,'(a)') 'Input: ['//trim(var)//' = '//trim(adjustl(intstring))//']' 667 668 end subroutine messages_print_var_valuei 669 ! --------------------------------------------------------- 670 671 ! --------------------------------------------------------- 672 subroutine messages_print_var_values(iunit, var, val) 673 integer, intent(in) :: iunit 674 character(len=*), intent(in) :: var 675 character(len=*), intent(in) :: val 676 677 if(.not. mpi_grp_is_root(mpi_world)) return 678 679 write(iunit,'(a)') 'Input: ['//trim(var)//' = '//trim(val)//']' 680 681 end subroutine messages_print_var_values 682 ! --------------------------------------------------------- 683 684 685 ! --------------------------------------------------------- 686 subroutine messages_print_var_valuer(iunit, var, val, unit) 687 integer, intent(in) :: iunit 688 character(len=*), intent(in) :: var 689 FLOAT, intent(in) :: val 690 type(unit_t), optional, intent(in) :: unit 691 692 character(len=10) :: floatstring 693 694 if(.not. mpi_grp_is_root(mpi_world)) return 695 696 if(.not. present(unit)) then 697 write(floatstring,'(g10.4)') val 698 write(iunit,'(a)') 'Input: ['//trim(var)//' = '//trim(adjustl(floatstring))//']' 699 else 700 write(floatstring,'(g10.4)') units_from_atomic(unit, val) 701 write(iunit,'(a)') 'Input: ['//trim(var)//' = '//trim(adjustl(floatstring))//' '//trim(units_abbrev(unit))//']' 702 end if 703 704 end subroutine messages_print_var_valuer 705 ! --------------------------------------------------------- 706 707 708 ! --------------------------------------------------------- 709 subroutine messages_print_var_valuel(iunit, var, val) 710 integer, intent(in) :: iunit 711 character(len=*), intent(in) :: var 712 logical, intent(in) :: val 713 714 character(len=3) :: lstring 715 716 if(.not. mpi_grp_is_root(mpi_world)) return 717 718 if(val) then 719 lstring = 'yes' 720 else 721 lstring = 'no' 722 end if 723 write(iunit,'(a)') 'Input: ['//trim(var)//' = '//trim(lstring)//']' 724 725 end subroutine messages_print_var_valuel 726 ! --------------------------------------------------------- 727 728 729 ! --------------------------------------------------------- 730 subroutine messages_print_var_valuear(iunit, var, val, unit) 731 integer, intent(in) :: iunit 732 character(len=*), intent(in) :: var 733 FLOAT, intent(in) :: val(:) 734 type(unit_t), optional, intent(in) :: unit 735 736 integer :: ii 737 character(len=10) :: floatstring 738 739 if(.not. mpi_grp_is_root(mpi_world)) return 740 741 call messages_write('Input: ['//trim(var)//' = (') 742 do ii = 1, size(val) 743 write(floatstring,'(g10.4)') val(ii) 744 call messages_write(trim(adjustl(floatstring))) 745 if(ii < size(val)) call messages_write(', ') 746 end do 747 call messages_write(')') 748 if(present(unit)) then 749 call messages_write(' '//trim(units_abbrev(unit))//']') 750 else 751 call messages_write(']') 752 end if 753 call messages_info(iunit = iunit) 754 755 end subroutine messages_print_var_valuear 756 ! --------------------------------------------------------- 757 758 759 ! --------------------------------------------------------- 760 subroutine messages_print_var_info(iunit, var) 761 integer, intent(in) :: iunit 762 character(len=*), intent(in) :: var 763 764 if(.not. mpi_grp_is_root(mpi_world)) return 765 766 call varinfo_print(iunit, var) 767 end subroutine messages_print_var_info 768 769 770 ! --------------------------------------------------------- 771 subroutine messages_print_var_option_8(iunit, var, option, pre) 772 integer, intent(in) :: iunit 773 character(len=*), intent(in) :: var 774 integer(8), intent(in) :: option 775 character(len=*), intent(in), optional :: pre 776 777 integer :: option4 778 779 option4 = int(option) 780 781 if(.not. mpi_grp_is_root(mpi_world)) return 782 783 if(flush_messages) then 784 open(unit=iunit_out, file='messages.stdout', & 785 action='write', position='append') 786 end if 787 788 if(present(pre)) then 789 call varinfo_print_option(iunit, var, option4, pre) 790 if(flush_messages) then 791 call varinfo_print_option(iunit_out, var, option4, pre) 792 end if 793 else 794 call varinfo_print_option(iunit, var, option4) 795 if(flush_messages) then 796 call varinfo_print_option(iunit_out, var, option4, pre) 797 end if 798 end if 799 800 if(flush_messages) then 801 close(iunit_out) 802 end if 803 end subroutine messages_print_var_option_8 804 805 ! --------------------------------------------------------- 806 subroutine messages_print_var_option_4(iunit, var, option, pre) 807 integer, intent(in) :: iunit 808 character(len=*), intent(in) :: var 809 integer(4), intent(in) :: option 810 character(len=*), intent(in), optional :: pre 811 812 call messages_print_var_option_8(iunit, var, int(option, 8), pre) 813 814 end subroutine messages_print_var_option_4 815 816 ! --------------------------------------------------------- 817 subroutine messages_print_stress(iunit, msg, namespace) 818 integer, intent(in) :: iunit 819 character(len=*), optional, intent(in) :: msg 820 type(namespace_t), optional, intent(in) :: namespace 821 822 integer, parameter :: max_len = 70 823 824 integer :: ii, jj, length 825 character(len=70) :: str 826 character(len=max_len) :: msg_combined 827 828 if(.not.mpi_grp_is_root(mpi_world)) return 829 830 if(flush_messages) then 831 open(unit=iunit_out, file='messages.stdout', & 832 action='write', position='append') 833 end if 834 835 if(present(msg)) then 836 ! make sure we do not get a segfault for too long messages 837 if(len_trim(msg) > max_len) then 838 msg_combined = trim(msg(1:max_len)) 839 else 840 msg_combined = trim(msg) 841 end if 842 if(present(namespace)) then 843 ! check if we are below the maximum length 844 if(len_trim(msg) + len_trim(namespace%get()) + 1 < max_len) then 845 ! only change message if namespace non-empty 846 if(len_trim(namespace%get()) > 0) then 847 msg_combined = trim(msg) // " " // trim(namespace%get()) 848 end if 849 end if 850 end if 851 length = len_trim(msg_combined) 852 853 str = '' 854 jj = 1 855 856 do ii = 1, (max_len - (length + 2))/2 857 str(jj:jj) = '*' 858 jj = jj + 1 859 end do 860 861 str(jj:jj) = ' ' 862 jj = jj + 1 863 864 do ii = 1, length 865 str(jj:jj) = msg_combined(ii:ii) 866 jj = jj + 1 867 end do 868 869 str(jj:jj) = ' ' 870 jj = jj + 1 871 872 do ii = jj, max_len 873 str(jj:jj) = '*' 874 jj = jj + 1 875 end do 876 877 call flush_msg(iunit, '') ! empty line 878 call flush_msg(iunit, str) ! out nice line with the header 879 else 880 do ii = 1, max_len 881 str(ii:ii) = '*' 882 end do 883 884 call flush_msg(iunit, str) ! out nice line with the header 885 call flush_msg(iunit, '') ! empty line 886 end if 887 888 if(flush_messages) close(iunit_out) 889 890#ifdef HAVE_FLUSH 891 call flush(iunit) 892#endif 893 end subroutine messages_print_stress 894 895 896 ! --------------------------------------------------------- 897 subroutine flush_msg(iunit, str, adv) 898 integer, intent(in) :: iunit 899 character(len = *), intent(in) :: str 900 character(len = *), optional, intent(in) :: adv 901 902 character(len = 20) :: adv_ 903 904 adv_ = 'yes' 905 if(present(adv)) adv_ = adv 906 907 write(iunit, '(a)', advance=trim(adv_)) trim(str) 908 if(flush_messages .and. mpi_grp_is_root(mpi_world)) then 909 if(iunit == stderr) write(iunit_err, '(a)', advance=trim(adv_)) trim(str) 910 if(iunit == stdout) write(iunit_out, '(a)', advance=trim(adv_)) trim(str) 911 end if 912 913 end subroutine flush_msg 914 915 916 ! --------------------------------------------------------- 917 subroutine print_date(str) 918 character(len = *), intent(in) :: str 919 920 integer :: val(8) 921 922 call date_and_time(values=val) 923 message(1) = "" 924 write(message(3),'(a,i4,a1,i2.2,a1,i2.2,a,i2.2,a1,i2.2,a1,i2.2)') & 925 str , val(1), "/", val(2), "/", val(3), & 926 " at ", val(5), ":", val(6), ":", val(7) 927 message(2) = str_center(trim(message(3)), 70) 928 message(3) = "" 929 call messages_info(3) 930 931 end subroutine print_date 932 933 ! --------------------------------------------------------- 934 subroutine epoch_time_diff(sec, usec) 935 integer, intent(inout) :: sec 936 integer, intent(inout) :: usec 937 938 ! this is called by push/pop so there cannot be a push/pop in this routine 939 940 call time_diff(s_epoch_sec, s_epoch_usec, sec, usec) 941 end subroutine epoch_time_diff 942 943 944 ! --------------------------------------------------------- 945 !> Computes t2 <- t2-t1. sec1,2 and usec1,2 are 946 !! seconds,microseconds of t1,2 947 subroutine time_diff(sec1, usec1, sec2, usec2) 948 integer, intent(in) :: sec1 949 integer, intent(in) :: usec1 950 integer, intent(inout) :: sec2 951 integer, intent(inout) :: usec2 952 953 ! this is called by push/pop so there cannot be a push/pop in this routine 954 955 ! Correct overflow. 956 if(usec2 - usec1 < 0) then 957 usec2 = 1000000 + usec2 958 if(sec2 >= sec1) then 959 sec2 = sec2 - 1 960 end if 961 end if 962 963 ! Replace values. 964 if(sec2 >= sec1) then 965 sec2 = sec2 - sec1 966 end if 967 usec2 = usec2 - usec1 968 969 end subroutine time_diff 970 971 ! --------------------------------------------------------- 972 !> Computes t2 <- t1+t2. Parameters as in time_diff 973 !! Assert: t1,2 <= 0. 974 subroutine time_sum(sec1, usec1, sec2, usec2) 975 integer, intent(in) :: sec1 976 integer, intent(in) :: usec1 977 integer, intent(inout) :: sec2 978 integer, intent(inout) :: usec2 979 980 PUSH_SUB(time_sum) 981 982 sec2 = sec1 + sec2 983 usec2 = usec1 + usec2 984 985 ! Carry? 986 if(usec2 >= 1000000) then 987 sec2 = sec2 + 1 988 usec2 = usec2 - 1000000 989 end if 990 991 POP_SUB(time_sum) 992 end subroutine time_sum 993 994 995#ifndef NDEBUG 996 ! --------------------------------------------------------- 997 subroutine push_sub(sub_name) 998 character(len=*), intent(in) :: sub_name 999 1000 integer iunit, sec, usec 1001 1002 if(.not. debug%trace) return 1003 1004 call loct_gettimeofday(sec, usec) 1005 call epoch_time_diff(sec, usec) 1006 1007 no_sub_stack = no_sub_stack + 1 1008 if(no_sub_stack > 49) then 1009 sub_stack(50) = 'push_sub' 1010 message(1) = 'Too many recursion levels (max=50)' 1011 call messages_fatal(1) 1012 end if 1013 1014 sub_stack(no_sub_stack) = trim(messages_clean_path(sub_name)) 1015 time_stack(no_sub_stack) = loct_clock() 1016 1017 if(debug%trace_file) then 1018 call open_debug_trace(iunit) 1019 call push_sub_write(iunit) 1020 ! close file to ensure flushing 1021 close(iunit) 1022 end if 1023 1024 if(debug%trace_term .and. mpi_grp_is_root(mpi_world)) then 1025 ! write to stderr if we are node 0 1026 call push_sub_write(stderr) 1027 end if 1028 1029 contains 1030 1031 subroutine push_sub_write(iunit_out) 1032 integer, intent(in) :: iunit_out 1033 1034 integer :: ii 1035 character(len=1000) :: tmpstr 1036 1037 write(tmpstr,'(a,i6,a,i6.6,f20.6,i8,a)') "* I ", & 1038 sec, '.', usec, & 1039 loct_clock(), & 1040 loct_get_memory_usage() / 1024, " | " 1041 do ii = no_sub_stack - 1, 1, -1 1042 write(tmpstr, '(2a)') trim(tmpstr), "..|" 1043 end do 1044 write(tmpstr, '(2a)') trim(tmpstr), trim(messages_clean_path(sub_name)) 1045 call flush_msg(iunit_out, tmpstr) 1046 1047 end subroutine push_sub_write 1048 1049 end subroutine push_sub 1050 1051 1052 ! --------------------------------------------------------- 1053 subroutine pop_sub(sub_name) 1054 character(len=*), intent(in) :: sub_name 1055 1056 character(len=80) :: sub_name_short 1057 1058 integer iunit, sec, usec 1059 1060 if(.not. debug%trace) return 1061 1062 call loct_gettimeofday(sec, usec) 1063 call epoch_time_diff(sec, usec) 1064 1065 if(no_sub_stack <= 0) then 1066 no_sub_stack = 1 1067 sub_stack(1) = 'pop_sub' 1068 message(1) = 'Too few recursion levels.' 1069 call messages_fatal(1) 1070 end if 1071 1072 ! the name might be truncated in sub_stack, so we copy to a string 1073 ! of the same size 1074 sub_name_short = trim(messages_clean_path(sub_name)) 1075 1076 if(sub_name_short /= sub_stack(no_sub_stack)) then 1077 write (message(1),'(a)') 'Wrong sub name on pop_sub :' 1078 write (message(2),'(2a)') ' got : ', sub_name_short 1079 write (message(3),'(2a)') ' expected : ', sub_stack(no_sub_stack) 1080 call messages_fatal(3) 1081 end if 1082 1083 if(debug%trace_file) then 1084 call open_debug_trace(iunit) 1085 call pop_sub_write(iunit) 1086 ! close file to ensure flushing 1087 close(iunit) 1088 end if 1089 1090 if (debug%trace_term .and. mpi_grp_is_root(mpi_world)) then 1091 ! write to stderr if we are node 0 1092 call pop_sub_write(stderr) 1093 end if 1094 1095 no_sub_stack = no_sub_stack - 1 1096 1097 contains 1098 1099 subroutine pop_sub_write(iunit_out) 1100 integer, intent(in) :: iunit_out 1101 1102 integer :: ii 1103 character(len=1000) :: tmpstr 1104 1105 write(tmpstr,'(a,i6,a,i6.6,f20.6,i8, a)') "* O ", & 1106 sec, '.', usec, & 1107 loct_clock() - time_stack(no_sub_stack), & 1108 loct_get_memory_usage() / 1024, " | " 1109 do ii = no_sub_stack - 1, 1, -1 1110 write(tmpstr,'(2a)') trim(tmpstr), "..|" 1111 end do 1112 write(tmpstr,'(2a)') trim(tmpstr), trim(sub_stack(no_sub_stack)) 1113 call flush_msg(iunit_out, tmpstr) 1114 1115 end subroutine pop_sub_write 1116 1117 end subroutine pop_sub 1118#endif 1119 1120 ! --------------------------------------------------------- 1121 subroutine messages_obsolete_variable(namespace, name, rep) 1122 type(namespace_t), intent(in) :: namespace 1123 character(len=*), intent(in) :: name 1124 character(len=*), optional, intent(in) :: rep 1125 1126 if(parse_is_defined(namespace, trim(name))) then 1127 1128 write(message(1), '(a)') 'Input variable '//trim(name)//' is obsolete.' 1129 1130 if(present(rep)) then 1131 write(message(2), '(a)') ' ' 1132 write(message(3), '(a)') 'Equivalent functionality can be obtained with the '//trim(rep) 1133 write(message(4), '(a)') 'variable. Check the documentation for details.' 1134 write(message(5), '(a)') '(You can use the `oct-help -p '//trim(rep)//'` command).' 1135 call messages_fatal(5, only_root_writes = .true.) 1136 else 1137 call messages_fatal(1, only_root_writes = .true.) 1138 end if 1139 1140 end if 1141 1142 end subroutine messages_obsolete_variable 1143 1144 ! --------------------------------------------------------- 1145 subroutine messages_experimental(name) 1146 character(len=*), intent(in) :: name 1147 1148 INCR(experimentals, 1) 1149 1150 if(.not. conf%devel_version) then 1151 call messages_write(trim(name)//' is an experimental feature.') 1152 call messages_new_line() 1153 call messages_new_line() 1154 call messages_write('If you still want to use this feature (at your own risk), check:') 1155 call messages_new_line() 1156 call messages_new_line() 1157 call messages_write('http://octopus-code.org/experimental_features') 1158 call messages_new_line() 1159 call messages_fatal(only_root_writes = .true.) 1160 else 1161 write(message(1), '(a)') trim(name)//' is under development.' 1162 write(message(2), '(a)') 'It might not work or produce wrong results.' 1163 call messages_warning(2) 1164 1165 ! remove this warning from the count 1166 INCR(warnings, -1) 1167 end if 1168 1169 end subroutine messages_experimental 1170 1171 1172 !-------------------------------------------------------------- 1173 subroutine messages_check_def(var, should_be_less, def, name, unit) 1174 FLOAT, intent(in) :: var 1175 logical, intent(in) :: should_be_less 1176 FLOAT, intent(in) :: def 1177 character(len=*), intent(in) :: name 1178 type(unit_t), optional, intent(in) :: unit 1179 1180 logical :: is_bad 1181 character(len=3) :: op_str 1182 1183 PUSH_SUB(messages_check_def) 1184 1185 if(should_be_less) then 1186 is_bad = var > def 1187 op_str = ' > ' 1188 else 1189 is_bad = var < def 1190 op_str = ' < ' 1191 end if 1192 1193 if(is_bad) then 1194 write(message(1), '(3a)') "The value for '", name, "' is inconsistent with the recommended value." 1195 if(present(unit)) then 1196 write(message(2), '(a,f8.3,4a,f8.3,a,a)') 'given ', units_from_atomic(unit, var), ' ', trim(units_abbrev(unit)), & 1197 op_str, 'recommended ', units_from_atomic(unit, def), ' ', trim(units_abbrev(unit)) 1198 else 1199 write(message(2), '(a,f8.3,2a,f8.3)') 'given ', var, op_str, 'recommended ', def 1200 end if 1201 call messages_warning(2) 1202 end if 1203 1204 POP_SUB(messages_check_def) 1205 end subroutine messages_check_def 1206 1207 1208 ! ------------------------------------------------------------ 1209 subroutine messages_not_implemented(feature, namespace) 1210 character(len=*), intent(in) :: feature 1211 type(namespace_t), optional, intent(in) :: namespace 1212 1213 PUSH_SUB(messages_not_implemented) 1214 1215 message(1) = trim(feature)//" not implemented." 1216 call messages_fatal(1, only_root_writes = .true., namespace=namespace) 1217 1218 POP_SUB(messages_not_implemented) 1219 end subroutine messages_not_implemented 1220 1221 ! ------------------------------------------------------------ 1222 1223 subroutine messages_reset_lines() 1224 1225 current_line = 1 1226 message(1) = '' 1227 1228 end subroutine messages_reset_lines 1229 1230 ! ------------------------------------------------------------ 1231 1232 subroutine messages_new_line() 1233 1234 current_line = current_line + 1 1235 message(current_line) = '' 1236 1237 if(current_line > max_lines) stop 'Too many message lines.' 1238 1239 end subroutine messages_new_line 1240 1241 ! ------------------------------------------------------------ 1242 1243 subroutine messages_write_float(val, fmt, new_line, units, align_left, print_units) 1244 FLOAT, intent(in) :: val 1245 character(len=*), optional, intent(in) :: fmt 1246 logical, optional, intent(in) :: new_line 1247 type(unit_t), optional, intent(in) :: units 1248 logical, optional, intent(in) :: align_left 1249 logical, optional, intent(in) :: print_units 1250 1251 character(len=30) :: number 1252 FLOAT :: tval 1253 1254 tval = val 1255 if(present(units)) tval = units_from_atomic(units, val) 1256 1257 if(present(fmt)) then 1258 write(number, '('//trim(fmt)//')') tval 1259 else 1260 write(number, '(f12.6)') tval 1261 end if 1262 1263 if(optional_default(align_left, .false.)) then 1264 number = adjustl(number) 1265 number(1:len(number)) = ' '//number(1:len(number)-1) 1266 end if 1267 1268 write(message(current_line), '(a, a)') trim(message(current_line)), trim(number) 1269 1270 if(present(units) .and. optional_default(print_units, .true.)) then 1271 write(message(current_line), '(a, a, a)') trim(message(current_line)), ' ', trim(units_abbrev(units)) 1272 end if 1273 1274 if(optional_default(new_line, .false.)) call messages_new_line() 1275 1276 end subroutine messages_write_float 1277 1278 ! ------------------------------------------------------------ 1279 1280 subroutine messages_write_integer8(val, fmt, new_line, units, print_units) 1281 integer(8), intent(in) :: val 1282 character(len=*), optional, intent(in) :: fmt 1283 logical, optional, intent(in) :: new_line 1284 type(unit_t), optional, intent(in) :: units 1285 logical, optional, intent(in) :: print_units 1286 1287 character(len=10) :: number 1288 integer(8) :: val_conv 1289 1290 val_conv = val 1291 if(present(units)) val_conv = int(nint(units_from_atomic(units, dble(val))), 8) 1292 1293 if(present(fmt)) then 1294 write(message(current_line), '(a, '//trim(fmt)//')') trim(message(current_line)), val_conv 1295 else 1296 write(number, '(i10)') val_conv 1297 write(message(current_line), '(3a)') trim(message(current_line)), ' ', trim(adjustl(number)) 1298 end if 1299 1300 1301 if(present(units) .and. optional_default(print_units, .true.)) then 1302 write(message(current_line), '(a, a, a)') trim(message(current_line)), ' ', trim(units_abbrev(units)) 1303 end if 1304 1305 if(present(new_line)) then 1306 if(new_line) call messages_new_line() 1307 end if 1308 1309 end subroutine messages_write_integer8 1310 1311 ! ------------------------------------------------------------ 1312 1313 subroutine messages_write_integer(val, fmt, new_line, units, print_units) 1314 integer(4), intent(in) :: val 1315 character(len=*), optional, intent(in) :: fmt 1316 logical, optional, intent(in) :: new_line 1317 type(unit_t), optional, intent(in) :: units 1318 logical, optional, intent(in) :: print_units 1319 1320 call messages_write_integer8(int(val, 8), fmt, new_line, units, print_units) 1321 1322 end subroutine messages_write_integer 1323 1324 ! ------------------------------------------------------------ 1325 1326 subroutine messages_write_str(val, fmt, new_line) 1327 character(len=*), intent(in) :: val 1328 character(len=*), optional, intent(in) :: fmt 1329 logical, optional, intent(in) :: new_line 1330 1331 character(len=100) :: fmt_ 1332 1333 if(len(trim(message(current_line))) + len(trim(val)) > len(message(current_line))) then 1334 ! cannot use normal message approach without interfering with message we are trying to write 1335 ! write directly in case trim(val) is itself too long 1336 write(0, *) "Exceeded message line length limit, to write string:", trim(val) 1337 else 1338 fmt_ = optional_default(fmt, '(a)') 1339 write(message(current_line), '(a, '//trim(fmt_)//')') trim(message(current_line)), trim(val) 1340 end if 1341 1342 if(present(new_line)) then 1343 if(new_line) call messages_new_line() 1344 end if 1345 1346 end subroutine messages_write_str 1347 1348 ! ------------------------------------------------------------ 1349 1350 subroutine messages_write_logical(val, new_line) 1351 logical, intent(in) :: val 1352 logical, optional, intent(in) :: new_line 1353 1354 character(len=3) :: text 1355 1356 if(val) then 1357 text = 'yes' 1358 else 1359 text = 'no' 1360 end if 1361 1362 if(len(trim(message(current_line))) + len(trim(text)) > len(message(current_line))) then 1363 write(message(current_line + 1), '(3a)') "Exceeded message line length limit, to write logical value '", trim(text), "'" 1364 call messages_fatal(current_line + 1) 1365 end if 1366 1367 write(message(current_line), '(a,1x,a)') trim(message(current_line)), trim(text) 1368 1369 if(present(new_line)) then 1370 if(new_line) call messages_new_line() 1371 end if 1372 1373 end subroutine messages_write_logical 1374 1375 ! ----------------------------------------------------------- 1376 1377 character(len=MAX_PATH_LEN) function messages_clean_path(filename) result(clean_path) 1378 character(len=*), intent(in) :: filename 1379 1380 integer :: pos, start 1381 1382 pos = index(filename, 'src/', back = .true.) 1383 if(pos == 0) then 1384 ! 'src/' does not occur 1385 start = pos + 1 1386 else 1387 ! remove 'src/' 1388 start = pos + 4 1389 end if 1390 clean_path = filename(start:) 1391 end function messages_clean_path 1392 1393 ! ----------------------------------------------------------- 1394 1395 subroutine messages_dump_stack(isignal) 1396 integer, intent(in) :: isignal 1397 1398 integer :: ii 1399 character(len=300) :: description 1400 1401 call get_signal_description(isignal, description) 1402 1403 write(msg, '(a,i2)') '' 1404 call flush_msg(stderr, msg) 1405 write(msg, '(a,i2)') '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%' 1406 call flush_msg(stderr, msg) 1407 write(msg, '(a,i2)') '' 1408 call flush_msg(stderr, msg) 1409 write(msg, '(a,i2,2a)') ' Octopus was killed by signal ', isignal, ': ', trim(description) 1410 call flush_msg(stderr, msg) 1411 write(msg, '(a,i2)') '' 1412 call flush_msg(stderr, msg) 1413 write(msg, '(a,i2)') '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%' 1414 call flush_msg(stderr, msg) 1415 1416 if(debug%trace) then 1417 call flush_msg(stderr, shyphens) 1418 1419 write(msg, '(a)') 'Octopus debug trace: ' 1420 call flush_msg(stderr, msg) 1421 do ii = 1, no_sub_stack 1422 write(msg, '(a,a)') ' > ', trim(sub_stack(ii)) 1423 call flush_msg(stderr, msg, 'no') 1424 end do 1425 call flush_msg(stderr, " ") 1426 else 1427 write(msg, '(a)') " Octopus debug trace not available. You can enable it with 'Debug = trace'." 1428 call flush_msg(stderr, msg) 1429 end if 1430 1431 end subroutine messages_dump_stack 1432 1433end module messages_oct_m 1434 1435! --------------------------------------------------------- 1436!> This subroutine is called by the assert macro, it is not in a 1437!> module so it can be called from any file. The interface is declared 1438!> in global_m. 1439subroutine assert_die(s, f, l) 1440 use messages_oct_m 1441 use mpi_oct_m 1442 1443 implicit none 1444 1445 character(len=*), intent(in) :: s, f 1446 integer, intent(in) :: l 1447 1448 call messages_write('Node ') 1449 call messages_write(mpi_world%rank) 1450 call messages_write(':') 1451 call messages_new_line() 1452 1453 call messages_write(' Assertion "'//trim(s)//'"') 1454 call messages_new_line() 1455 1456 call messages_write(' failed in line ') 1457 call messages_write(l) 1458 call messages_write(' of file "'//trim(messages_clean_path(f))//'".') 1459 1460 call messages_fatal() 1461 1462end subroutine assert_die 1463 1464!------------------------------------------------------- 1465 1466subroutine dump_call_stack(isignal) 1467 use messages_oct_m 1468 1469 implicit none 1470 1471 integer, intent(in) :: isignal 1472 1473 call messages_dump_stack(isignal) 1474 1475end subroutine dump_call_stack 1476 1477 1478!! Local Variables: 1479!! mode: f90 1480!! coding: utf-8 1481!! End: 1482