TABLE OF CONTENTS
- ABINIT/m_errors
- m_errors/abi_abort
- m_errors/abi_cabort
- m_errors/abinit_doctor
- m_errors/assert1
- m_errors/assert2
- m_errors/assert3
- m_errors/assert4
- m_errors/assert_eq2
- m_errors/assert_eq3
- m_errors/assert_eq4
- m_errors/assert_eqn
- m_errors/assert_v
- m_errors/bigdft_lib_error
- m_errors/check_mpi_ierr
- m_errors/die
- m_errors/msg_hndl
- m_errors/netcdf_check
- m_errors/sentinel
- m_errors/set_backtrace_onerr
- m_errors/show_backtrace
- m_errors/unused_ch
- m_errors/unused_cplx_dpc
- m_errors/unused_cplx_spc
- m_errors/unused_int
- m_errors/unused_logical
- m_errors/unused_logical1B
- m_errors/unused_real_dp
- m_errors/unused_real_sp
- m_errors/xlf_set_sighandler
ABINIT/m_errors [ Modules ]
NAME
m_errors
FUNCTION
This module contains low-level procedures to check assertions and handle errors.
COPYRIGHT
Copyright (C) 2008-2022 ABINIT group (MG,YP,NCJ,MT) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
SOURCE
16 #if defined HAVE_CONFIG_H 17 #include "config.h" 18 #endif 19 20 #include "abi_common.h" 21 22 MODULE m_errors 23 24 use defs_basis 25 use m_profiling_abi 26 use m_xmpi 27 use m_specialmsg, only : wrtout 28 #ifdef HAVE_NETCDF 29 use netcdf 30 #endif 31 #ifdef HAVE_MPI2 32 use mpi 33 #endif 34 #ifdef FC_NAG 35 use f90_unix_proc 36 #endif 37 #ifdef FC_INTEL 38 use ifcore 39 #endif 40 41 use m_io_tools, only : flush_unit, lock_and_write, file_exists, num_opened_units, show_units, open_file 42 use m_fstrings, only : toupper, basename, indent, lstrip, atoi, strcat, itoa 43 use m_build_info, only : dump_config, abinit_version 44 use m_cppopts_dumper, only : dump_cpp_options 45 use m_optim_dumper, only : dump_optim 46 47 implicit none 48 49 #if defined HAVE_MPI1 50 include 'mpif.h' 51 #endif 52 53 #ifdef FC_IBM 54 include "fexcp.h" 55 #endif 56 57 private
m_errors/abi_abort [ Functions ]
[ Top ] [ m_errors ] [ Functions ]
NAME
abi_abort
FUNCTION
Routine for clean exit of f90 code, taking into account possible parallelization. Note the this routine is private and should never be called explicitly. Please, use the macros: MSG_ERROR, MSG_BUG defined in abi_common.h to abort the execution. XG : this is not true, in very rare cases, ABINIT has to exit without giving an error (e.g. for non-zero prtkpt )
INPUTS
exit_status=(optional, default=1 or -1, see below) the return code of the routine mode_paral= 'COLL' if all procs are calling the routine with the same message to be written once only or 'PERS' if the procs are calling the routine with different mesgs each to be written, or if one proc is calling the routine print_config=(optional, default=true) if true print out several information before leaving
OUTPUT
(only writing, then stop)
NOTES
By default, it uses "call exit(1)", that is not completely portable.
SOURCE
1369 subroutine abi_abort(mode_paral,exit_status,print_config) 1370 1371 !Arguments ------------------------------------ 1372 character(len=4),intent(in) :: mode_paral 1373 integer,intent(in),optional :: exit_status 1374 logical,intent(in),optional :: print_config 1375 1376 !Local variables------------------------------- 1377 logical :: print_config_ 1378 1379 ! ********************************************************************** 1380 1381 call wrtout(std_out, ch10//' abinit_abort: decision taken to exit. Check above messages for more info', 'PERS') 1382 1383 ! Caveat: Do not use MPI collective calls! 1384 if (mode_paral == "COLL") then 1385 call wrtout(std_out,"Why are you using COLL? Are you sure that ALL the processors are calling abi_abort?") 1386 end if 1387 1388 ! Dump configuration before exiting 1389 print_config_=.False.; if (present(print_config)) print_config_=print_config 1390 if (print_config_) then 1391 call print_kinds() 1392 call xmpi_show_info() 1393 call dump_config(std_out) 1394 end if 1395 1396 if (present(exit_status)) then 1397 call xmpi_abort(exit_status=exit_status) 1398 else 1399 call xmpi_abort() 1400 end if 1401 1402 end subroutine abi_abort
m_errors/abi_cabort [ Functions ]
[ Top ] [ m_errors ] [ Functions ]
NAME
abi_cabort
FUNCTION
C-interoperable version of abi_abort
m_errors/abinit_doctor [ Functions ]
[ Top ] [ m_errors ] [ Functions ]
NAME
abinit_doctor
FUNCTION
Perform checks on memory leaks and leaking file descriptors at the end of the run.
INPUTS
prefix=Prefix for output file (usually "__nameofprogram" e.g. __cut3d) [print_mem_report]=0 to disable the test on memory leaks (used in Abinit if bigdft is activated). Default: 1, i.e. memory check is always activated.
SOURCE
1218 subroutine abinit_doctor(prefix, print_mem_report) 1219 1220 !Arguments ------------------------------------ 1221 integer,optional,intent(in) :: print_mem_report 1222 character(len=*),intent(in) :: prefix 1223 1224 !Local variables------------------------------- 1225 !scalars 1226 integer,parameter :: master=0 1227 integer :: do_mem_report, my_rank 1228 character(len=5000) :: msg 1229 #ifdef HAVE_MEM_PROFILING 1230 integer :: ii,ierr,unt 1231 integer(i8b) :: memtot, nalloc, nfree, nalloc_c, nfree_c 1232 character(len=fnlen) :: path 1233 character(len=5000) :: errmsg 1234 #endif 1235 1236 ! ************************************************************************* 1237 1238 do_mem_report = 1; if (present(print_mem_report)) do_mem_report = print_mem_report 1239 my_rank = xmpi_comm_rank(xmpi_world) 1240 1241 #ifdef HAVE_MEM_PROFILING 1242 errmsg = ""; ierr = 0 1243 1244 ! Test on memory leaks. 1245 call abimem_get_info(nalloc, nfree, memtot, nalloc_c, nfree_c) 1246 call abimem_shutdown() 1247 1248 if (do_mem_report == 1) then 1249 1250 ! Check memory allocated in C. 1251 if (nalloc_c == nfree_c) then 1252 write(msg,'(2a, 2(a,i0), a)') & 1253 '- [ALL OK] MEMORY CONSUMPTION REPORT FOR C CODE:',ch10, & 1254 '- There were ',nalloc_c,' allocations and ',nfree_c,' deallocations in C code' 1255 else 1256 ! This msg will make the test fail if the memory leak occurs on master (no dash in the first column) 1257 write(msg,'(2a,2(a,i0),3a)') & 1258 'MEMORY CONSUMPTION REPORT FOR C CODE:',ch10, & 1259 ' There were ',nalloc_c,' allocations and ',nfree_c,' deallocations in C code',ch10, & 1260 " Check your C code for memory leaks. Note that the abimem.py script does not support allocations in C" 1261 ! And this will make the code call mpi_abort if the leak occurs on my_rank != master 1262 ierr = ierr + 1 1263 errmsg = strcat(errmsg, ch10, msg) 1264 end if 1265 if (my_rank == master) call wrtout(ab_out, msg) 1266 call wrtout(std_out, msg) 1267 1268 ! Check memory allocated in Fortran. 1269 if (nalloc == nfree .and. memtot == 0) then 1270 write(msg,'(3a,i0,a,i0,3a,i0)') & 1271 '- [ALL OK] MEMORY CONSUMPTION REPORT FOR FORTRAN CODE:',ch10, & 1272 '- There were ',nalloc,' allocations and ',nfree,' deallocations in Fortran',ch10, & 1273 '- Remaining memory at the end of the calculation is ',memtot 1274 else 1275 ! This msg will make the test fail if the memory leak occurs on master (no dash in the first column) 1276 write(msg,'(2a,2(a,i0),3a,f12.4,1x,11a)') & 1277 'MEMORY CONSUMPTION REPORT FOR FORTRAN CODE:',ch10, & 1278 ' There were ',nalloc,' allocations and ',nfree,' deallocations in Fortran',ch10, & 1279 ' Remaining memory at the end of the calculation: ',memtot * b2Mb, " (Mb)", ch10, & 1280 ' As a help for debugging, you might set call abimem_init(2) in the main program,', ch10, & 1281 ' or use the command line option `abinit run.abi --abimem-level 2`', ch10, & 1282 ' then use tests/Scripts/abimem.py to analyse the file abimem_rank[num].mocc that has been created,',ch10, & 1283 ' e.g. from tests/Scripts issue the command: ./abimem.py leaks ../<dir>/<subdir>/abimem_rank0.mocc',ch10, & 1284 ' Note that abimem files can easily be multiple GB in size so do not use this option normally!' 1285 ! And this will make the code call mpi_abort if the leak occurs on my_rank != master 1286 ierr = ierr + 1 1287 errmsg = strcat(errmsg, ch10, msg) 1288 end if 1289 1290 else 1291 write(msg,'(3a)') & 1292 '- MEMORY CONSUMPTION REPORT:',ch10, & 1293 '- Memory profiling is activated but not yet usable when bigdft is used' 1294 end if 1295 if (my_rank == master) call wrtout(ab_out, msg) 1296 call wrtout(std_out, msg) 1297 1298 ! Test whether all logical units have been closed. 1299 ! If you wonder why I'm doing this, remember that there's a per-user 1300 ! limit on the maximum number of open file descriptors. Hence descriptors 1301 ! represent a precious resource and we should close them as soon as possible. 1302 ii = num_opened_units(ignore=[std_err, std_in, std_out, ab_out]) 1303 if (ii > 0) then 1304 path = strcat(prefix, "_lunits_rank", itoa(my_rank), ".flun") 1305 if (open_file(path, msg, newunit=unt) /= 0) then 1306 ABI_ERROR(msg) 1307 end if 1308 call show_units(unt) 1309 close(unt) 1310 write(msg, "(a,i0,2a)")"Leaking ",ii," Fortran logical units. See: ",trim(path) 1311 errmsg = strcat(errmsg, ch10, msg) 1312 ierr = ierr + 1 1313 if (my_rank == master) call wrtout(ab_out, msg) 1314 call wrtout(std_out, msg) 1315 end if 1316 1317 call xmpi_barrier(xmpi_world) 1318 if (ierr /= 0) then 1319 ABI_ERROR(errmsg) 1320 end if 1321 1322 #else 1323 ABI_UNUSED(prefix) 1324 #endif 1325 1326 ! Check for pending requests. 1327 if (xmpi_count_requests /= 0) then 1328 write(msg, "(a,i0,a)")"Leaking ", xmpi_count_requests, " MPI requests at the end of the run" 1329 ABI_WARNING(msg) 1330 #ifdef HAVE_MEM_PROFILING 1331 ABI_ERROR(msg) 1332 #endif 1333 end if 1334 1335 end subroutine abinit_doctor
m_errors/assert1 [ Functions ]
[ Top ] [ m_errors ] [ Functions ]
NAME
assert1
FUNCTION
Routines for argument checking and error handling. Report and die if any logical is false (used for arg range checking).
INPUTS
l1,l2,.. logical values to be checked (array version is also provided) message(len=*)=tag with additiona information
SOURCE
288 subroutine assert1(l1,message,file,line) 289 290 !Arguments ------------------------------------ 291 integer,optional,intent(in) :: line 292 character(len=*),intent(in) :: message 293 character(len=*),optional,intent(in) :: file 294 logical,intent(in) :: l1 295 296 !Local variables------------------------------- 297 integer :: f90line=0 298 character(len=500) :: f90name='Subroutine Unknown' 299 ! ************************************************************************* 300 301 if (.not.l1) then 302 if (PRESENT(line)) f90line=line 303 if (PRESENT(file)) f90name= basename(file) 304 call msg_hndl(message,'ERROR','PERS',f90name,f90line) 305 end if 306 307 end subroutine assert1
m_errors/assert2 [ Functions ]
[ Top ] [ m_errors ] [ Functions ]
NAME
assert2
FUNCTION
Routines for argument checking and error handling. Report and die if
INPUTS
l1,l2,.. logical values to be checked (array version is also provided) message(len=*)=tag with additional information
SOURCE
326 subroutine assert2(l1,l2,message,file,line) 327 328 !Arguments ------------------------------------ 329 integer,optional,intent(in) :: line 330 character(len=*),intent(in) :: message 331 character(len=*),optional,intent(in) :: file 332 logical,intent(in) :: l1,l2 333 334 !Local variables------------------------------- 335 integer :: f90line=0 336 character(len=500) :: f90name='Subroutine Unknown' 337 ! ************************************************************************* 338 339 if (.not.(l1.and.l2)) then 340 if (PRESENT(line)) f90line=line 341 if (PRESENT(file)) f90name= basename(file) 342 call msg_hndl(message,'ERROR','PERS',f90name,f90line) 343 end if 344 345 end subroutine assert2
m_errors/assert3 [ Functions ]
[ Top ] [ m_errors ] [ Functions ]
NAME
assert3
FUNCTION
Routines for argument checking and error handling. Report and die if any logical is false (used for arg range checking).
INPUTS
l1,l2,.. logical values to be checked (array version is also provided) message(len=*)=tag with additional information
SOURCE
364 subroutine assert3(l1,l2,l3,message,file,line) 365 366 !Arguments ------------------------------------ 367 integer,optional,intent(in) :: line 368 character(len=*),intent(in) :: message 369 character(len=*),optional,intent(in) :: file 370 logical,intent(in) :: l1,l2,l3 371 372 !Local variables------------------------------- 373 integer :: f90line=0 374 character(len=500) :: f90name='Subroutine Unknown' 375 ! ************************************************************************* 376 377 if (.not.(l1.and.l2.and.l3)) then 378 if (PRESENT(line)) f90line=line 379 if (PRESENT(file)) f90name= basename(file) 380 call msg_hndl(message,'ERROR','PERS',f90name,f90line) 381 end if 382 383 end subroutine assert3
m_errors/assert4 [ Functions ]
[ Top ] [ m_errors ] [ Functions ]
NAME
assert4
FUNCTION
Routines for argument checking and error handling. Report and die if any logical is false (used for arg range checking).
INPUTS
l1,l2,.. logical values to be checked (array version is also provided) message(len=*)=tag with additional information
SOURCE
402 subroutine assert4(l1,l2,l3,l4,message,file,line) 403 404 !Arguments ------------------------------------ 405 integer,optional,intent(in) :: line 406 character(len=*),intent(in) :: message 407 character(len=*),optional,intent(in) :: file 408 logical,intent(in) :: l1,l2,l3,l4 409 410 !Local variables------------------------------- 411 integer :: f90line=0 412 character(len=500) :: f90name='Subroutine Unknown' 413 ! ************************************************************************* 414 415 if (.not.(l1.and.l2.and.l3.and.l4)) then 416 if (PRESENT(line)) f90line=line 417 if (PRESENT(file)) f90name= basename(file) 418 call msg_hndl(message,'ERROR','PERS',f90name,f90line) 419 end if 420 421 end subroutine assert4
m_errors/assert_eq2 [ Functions ]
[ Top ] [ m_errors ] [ Functions ]
NAME
assert_eq2
FUNCTION
Report and die gracefully if integers not all equal (used for size checking).
INPUTS
l1,l2,.. Integers to be checked (array version is also provided) message(len=*)=tag with additional information
SOURCE
127 function assert_eq2(l1,l2,message,file,line) 128 129 !Arguments ------------------------------------ 130 integer,intent(in) :: l1,l2 131 integer,optional,intent(in) :: line 132 integer :: assert_eq2 133 character(len=*),intent(in) :: message 134 character(len=*),optional,intent(in) :: file 135 136 !Local variables------------------------------- 137 integer :: f90line=0 138 character(len=500) :: f90name='Subroutine Unknown' 139 140 ! ************************************************************************* 141 142 if (l1==l2) then 143 assert_eq2=l1 144 else 145 if (PRESENT(line)) f90line=line 146 if (PRESENT(file)) f90name= basename(file) 147 call msg_hndl(message,'ERROR','PERS',f90name,line) 148 end if 149 150 end function assert_eq2
m_errors/assert_eq3 [ Functions ]
[ Top ] [ m_errors ] [ Functions ]
NAME
assert_eq3
FUNCTION
Report and die gracefully if integers not all equal (used for size checking).
INPUTS
l1,l2,.. Integers to be checked (array version is also provided) message(len=*)=tag with additional information
SOURCE
168 function assert_eq3(l1,l2,l3,message,file,line) 169 170 !Arguments ------------------------------------ 171 integer,intent(in) :: l1,l2,l3 172 integer,optional,intent(in) :: line 173 integer :: assert_eq3 174 character(len=*),intent(in) :: message 175 character(len=*),optional,intent(in) :: file 176 177 !Local variables------------------------------- 178 integer :: f90line=0 179 character(len=500) :: f90name='Subroutine Unknown' 180 ! ************************************************************************* 181 182 if (l1==l2.and.l2==l3) then 183 assert_eq3=l1 184 else 185 if (PRESENT(line)) f90line=line 186 if (PRESENT(file)) f90name= basename(file) 187 call msg_hndl(message,'ERROR','PERS',f90name,line) 188 end if 189 190 end function assert_eq3
m_errors/assert_eq4 [ Functions ]
[ Top ] [ m_errors ] [ Functions ]
NAME
assert_eq4
FUNCTION
Report and die gracefully if integers not all equal (used for size checking).
INPUTS
l1,l2,.. Integers to be checked (array version is also provided) message(len=*)=tag with additional information
SOURCE
208 function assert_eq4(l1,l2,l3,l4,message,file,line) 209 210 !Arguments ------------------------------------ 211 !scalars 212 integer,intent(in) :: l1,l2,l3,l4 213 integer,optional,intent(in) :: line 214 integer :: assert_eq4 215 character(len=*),intent(in) :: message 216 character(len=*),optional,intent(in) :: file 217 218 !Local variables------------------------------- 219 integer :: f90line=0 220 character(len=500) :: f90name='Subroutine Unknown' 221 ! ************************************************************************* 222 223 if (l1==l2.and.l2==l3.and.l3==l4) then 224 assert_eq4=l1 225 else 226 if (PRESENT(line)) f90line=line 227 if (PRESENT(file)) f90name= basename(file) 228 call msg_hndl(message,'ERROR','PERS',f90name,line) 229 end if 230 231 end function assert_eq4
m_errors/assert_eqn [ Functions ]
[ Top ] [ m_errors ] [ Functions ]
NAME
assert_eqn
FUNCTION
Report and die gracefully if integers not all equal (used for size checking).
SOURCE
245 function assert_eqn(nn,message,file,line) 246 247 !Arguments ------------------------------------ 248 !scalars 249 integer,optional,intent(in) :: line 250 integer :: assert_eqn 251 character(len=*),intent(in) :: message 252 character(len=*),optional,intent(in) :: file 253 !arrays 254 integer,intent(in) :: nn(:) 255 256 !Local variables------------------------------- 257 integer :: f90line=0 258 character(len=500) :: f90name='Subroutine Unknown' 259 ! ************************************************************************* 260 261 if (ALL(nn(2:)==nn(1))) then 262 assert_eqn=nn(1) 263 else 264 if (PRESENT(line)) f90line=line 265 if (PRESENT(file)) f90name= basename(file) 266 call msg_hndl(message,'ERROR','PERS',f90name,line) 267 end if 268 269 end function assert_eqn
m_errors/assert_v [ Functions ]
[ Top ] [ m_errors ] [ Functions ]
NAME
assert_v
FUNCTION
Routines for argument checking and error handling. Report and die if any logical is false (used for arg range checking).
SOURCE
436 subroutine assert_v(n,message,file,line) 437 438 !Arguments ------------------------------------ 439 integer,optional,intent(in) :: line 440 character(len=*),intent(in) :: message 441 character(len=*),optional,intent(in) :: file 442 logical,intent(in) :: n(:) 443 444 !Local variables------------------------------- 445 integer :: f90line=0 446 character(len=500) :: f90name='Subroutine Unknown' 447 ! ************************************************************************* 448 449 if (.not.ALL(n)) then 450 if (PRESENT(line)) f90line=line 451 if (PRESENT(file)) f90name= basename(file) 452 call msg_hndl(message,'ERROR','PERS',f90name,f90line) 453 end if 454 455 end subroutine assert_v
m_errors/bigdft_lib_error [ Functions ]
[ Top ] [ m_errors ] [ Functions ]
NAME
bigdft_lib_error
FUNCTION
Stop the code if bigdft library has not been enabled. Interfaced with the CPP macro BIGDFT_NOTENABLED_ERROR
INPUTS
line=line number of the file where problem occurred file=name of the f90 file containing the caller
SOURCE
1137 subroutine bigdft_lib_error(file,line) 1138 1139 !Arguments ------------------------------------ 1140 integer,optional,intent(in) :: line 1141 character(len=*),optional,intent(in) :: file 1142 1143 !Local variables------------------------------- 1144 character(len=500) :: message 1145 1146 ! ********************************************************************* 1147 1148 write(message,'(4a)') ch10,& 1149 & ' BigDFT support has not been enabled.', ch10, & 1150 & ' Action, used the flag --enable-bigdft when configuring.' 1151 1152 if (PRESENT(file) .and. PRESENT(line)) then 1153 call msg_hndl(message,"ERROR","PERS",file=file,line=line) 1154 else 1155 call msg_hndl(message,"ERROR", "PERS") 1156 end if 1157 1158 end subroutine bigdft_lib_error
m_errors/check_mpi_ierr [ Functions ]
[ Top ] [ m_errors ] [ Functions ]
NAME
check_mpi_ierr
FUNCTION
Basic error handler for MPI calls. This routine is usually interfaced through some macro defined in abi_common.h
INPUTS
ierr=Exit status reported by an MPI call. line=line number of the file where problem occurred file=name of the f90 file containing the caller
OUTPUT
Write error message thep stop execution.
SOURCE
836 subroutine check_mpi_ierr(ierr, msg, file, line) 837 838 !Arguments ------------------------------------ 839 integer,intent(in) :: ierr 840 integer,optional,intent(in) :: line 841 character(len=*),intent(in) :: msg 842 character(len=*),optional,intent(in) :: file 843 844 !Local variables------------------------------- 845 integer,parameter :: mpi_msg_len=1000 846 integer :: f90line,ilen,ierr2 847 character(len=500) :: f90name='Subroutine Unknown' 848 character(len=mpi_msg_len) :: mpi_msg_error 849 character(len=mpi_msg_len+500) :: my_msg 850 ! ********************************************************************* 851 852 #ifdef HAVE_MPI 853 if (ierr==MPI_SUCCESS) RETURN 854 call MPI_ERROR_STRING(ierr, mpi_msg_error, ilen, ierr2) 855 #else 856 ilen=0; ierr2=0 857 mpi_msg_error = " Check_mpi_ierr should not be called in non-MPI mode!" 858 if (ierr==0) RETURN 859 #endif 860 861 if (ilen>mpi_msg_len) write(std_out,*)" Warning_ MPI message has been truncated!" 862 if (ierr2/=0) write(std_out,*)" Warning: MPI_ERROR_STRING returned ierr2= ",ierr2 863 864 f90line=0; if (PRESENT(line)) f90line=line 865 if (PRESENT(file)) f90name = basename(file) 866 my_msg = TRIM(msg)//ch10//TRIM(mpi_msg_error) 867 868 call msg_hndl(my_msg,"ERROR","PERS",file=f90name,line=f90line) 869 870 end subroutine check_mpi_ierr
m_errors/die [ Functions ]
[ Top ] [ m_errors ] [ Functions ]
NAME
die
FUNCTION
Stop smoothly the execution in case of unexpected events reporting the line number and the file name where the error occurred as well as the MPI rank of the processor. This routine is usually interfaced through some macro defined in abi_common.h
INPUTS
message=String containing additional information on the nature of the problem line=Line number of the file where problem occurred f90name=Name of the f90 file containing the caller
SOURCE
613 subroutine die(message,file,line) 614 615 !Arguments ------------------------------------ 616 integer,optional,intent(in) :: line 617 character(len=*),intent(in) :: message 618 character(len=*),optional,intent(in) :: file 619 620 !Local variables------------------------------- 621 integer :: rank 622 integer :: f90line=0 623 character(len=10) :: lnum,strank 624 character(len=500) :: f90name='Subroutine Unknown' 625 character(len=500) :: msg 626 627 ! ********************************************************************* 628 629 if (PRESENT(line)) f90line=line 630 write(lnum,"(i0)")f90line 631 632 ! === Determine my rank inside MPI_COMM_WORLD === 633 rank = xmpi_comm_rank(xmpi_world) 634 write(strank,"(i0)")rank 635 636 if (PRESENT(file)) f90name= basename(file) 637 msg=TRIM(f90name)//':'//TRIM(lnum)//' P'//TRIM(strank) 638 639 write(msg,'(a,2x,2a,2x,a)')ch10,TRIM(msg),ch10,TRIM(message) 640 641 call wrtout(std_out,msg,'PERS') 642 !if is_connected(ab_out)) call wrtout(ab_out,msg,'PERS') 643 call abi_abort('PERS') 644 645 end subroutine die
m_errors/msg_hndl [ Functions ]
[ Top ] [ m_errors ] [ Functions ]
NAME
msg_hndl
FUNCTION
Basic error handler for abinit. This routine is usually interfaced through some macro defined in abi_common.h
INPUTS
message=string containing additional information on the nature of the problem level=string defining the type of problem. Possible values are COMMENT WARNING ERROR STOP BUG mode_paral=Either "COLL" or "PERS". [line] = line number of the file where problem occurred [file] = name of the f90 file containing the caller [NODUMP]= if present dump config before stopping [NOSTOP]= if present don't stop even in the case of an error or a bug [unit]= Unit number (defaults to std_out)
OUTPUT
SOURCE
676 subroutine msg_hndl(message, level, mode_paral, file, line, NODUMP, NOSTOP, unit) 677 678 !Arguments ------------------------------------ 679 integer,optional,intent(in) :: line, unit 680 logical,optional,intent(in) :: NODUMP,NOSTOP 681 character(len=*),intent(in) :: level,message 682 character(len=*),optional,intent(in) :: file 683 character(len=*),intent(in) :: mode_paral 684 685 !Local variables------------------------------- 686 integer :: f90line,ierr,unit_ 687 logical :: is_open_unit 688 character(len=10) :: lnum 689 character(len=500) :: f90name 690 character(len=LEN(message)) :: my_msg 691 character(len=MAX(4*LEN(message),2000)) :: sbuf ! Increase size and keep fingers crossed! 692 693 ! ********************************************************************* 694 unit_ = std_out; if (present(unit)) unit_ = unit 695 696 if (PRESENT(line)) then 697 f90line=line 698 else 699 f90line=0 700 end if 701 ! TODO: fldiff.py should ignore f90line when comparing files (we don't want to 702 ! update ref files if a new line is added to F90 source file! 703 if (unit_ == ab_out) f90line = 0 704 write(lnum,"(i0)")f90line 705 706 if (PRESENT(file)) then 707 f90name = basename(file) 708 else 709 f90name='Subroutine Unknown' 710 end if 711 712 my_msg = lstrip(message) 713 714 select case (toupper(level)) 715 716 case ('COMMENT', 'WARNING') 717 718 write(sbuf,'(8a,i0,7a)')ch10,& 719 "--- !",TRIM(level),ch10,& 720 "src_file: ",TRIM(f90name),ch10,& 721 "src_line: ",f90line,ch10,& 722 "message: |",ch10,TRIM(indent(my_msg)),ch10,& 723 "...",ch10 724 call wrtout(unit_, sbuf, mode_paral) 725 726 case ('STOP') 727 728 write(sbuf,'(9a)')ch10,& 729 "--- !",TRIM(level),ch10,& 730 "message: |",ch10,TRIM(indent(my_msg)),ch10,"..." 731 call wrtout(unit_, sbuf, mode_paral, do_flush=.True.) 732 if (.not.present(NOSTOP)) call abi_abort(mode_paral, print_config=.FALSE.) 733 734 case default 735 ! ERROR' or 'BUG' 736 if ((.not.present(NOSTOP)).and.(.not.present(NODUMP))) then 737 ! Dump the backtrace if the compiler supports it. 738 if (m_errors_show_backtrace == 1) call show_backtrace() 739 end if 740 741 write(sbuf,'(8a,i0,2a,i0,7a)')ch10,& 742 "--- !",TRIM(level),ch10,& 743 "src_file: ",TRIM(f90name),ch10,& 744 "src_line: ",f90line,ch10,& 745 "mpi_rank: ",xmpi_comm_rank(xmpi_world),ch10,& 746 "message: |",ch10,TRIM(indent(my_msg)),ch10,& 747 "...",ch10 748 call wrtout(unit_, sbuf, mode_paral) 749 750 ! Write error message to ab_out is unit is connected. 751 inquire(unit=ab_out, opened=is_open_unit) 752 if (is_open_unit) call wrtout(ab_out, sbuf) !, mode_paral="PERS") 753 754 if (.not.present(NOSTOP)) then 755 ! The first MPI proc that gets here, writes the ABI_MPIABORTFILE with the message! 756 ! The file is written only if nprocs > 1. Do not change this behaviour! 757 if (.not. file_exists(ABI_MPIABORTFILE) .and. xmpi_comm_size(xmpi_world) > 1) then 758 call lock_and_write(ABI_MPIABORTFILE, sbuf, ierr) 759 end if 760 ! And now we die! 761 call abi_abort(mode_paral, print_config=.FALSE.) 762 end if 763 764 end select 765 766 end subroutine msg_hndl
m_errors/netcdf_check [ Functions ]
[ Top ] [ m_errors ] [ Functions ]
NAME
netcdf_check
FUNCTION
Error handler for Netcdf calls.
INPUTS
ncerr=Status error returned by the Netcdf library. msg=User-defined string with info on the action that was performed file= name of the file. line= line number.
NOTES
This routine is usually interfaced with the macros defined in abi_common.h
SOURCE
478 subroutine netcdf_check(ncerr, msg, file, line) 479 480 !Arguments ------------------------------------ 481 integer,intent(in) :: ncerr 482 character(len=*),intent(in) :: msg 483 character(len=*),optional,intent(in) :: file 484 integer,optional,intent(in) :: line 485 486 !Local variables------------------------------- 487 integer :: f90line 488 character(len=500) :: f90name 489 character(len=1024) :: nc_msg 490 character(len=2048) :: my_msg 491 492 ! ************************************************************************* 493 494 #ifdef HAVE_NETCDF 495 if (ncerr /= NF90_NOERR) then 496 497 f90line = 0; if (present(line)) f90line = line 498 f90name = 'Subroutine Unknown'; if (present(file)) f90name = basename(file) 499 500 ! Append netcdf string to user-defined message. 501 write(nc_msg,'(3a)')' - NetCDF library returned: `', trim(nf90_strerror(ncerr)),"`" 502 my_msg = trim(msg) // trim(nc_msg) 503 504 call msg_hndl(my_msg, "ERROR", "PERS", f90name, f90line) 505 end if 506 #endif 507 508 end subroutine netcdf_check
m_errors/sentinel [ Functions ]
[ Top ] [ m_errors ] [ Functions ]
NAME
sentinel
FUNCTION
Announce the entering and the exiting from a function. Useful for poor-man debugging.
INPUTS
level=1 when entering, 2 for exit. mode_paral= ['COLL'|'PERS'|'COLL_SILENT|PERS_SILENT'] 'COLL' and 'PERS' refer to the output mode used in wrtout to report the message. 'COLL_SILENT' and 'PERS_SILENT' can be used if the procedure is called several times inside a loop. In this case sentinel will report only the first entry and the first exit using either 'COLL' or 'PERS' mode. file=File name func=Name of the procedure to be tested (passed through ABI_FUNC macro) [line]=Line number. Defaults to 0.
NOTES
This routine is usually interfaced with the macros defined in abi_common.h
SOURCE
535 subroutine sentinel(level,mode_paral,file,func,line) 536 537 !Arguments ------------------------------------ 538 integer,intent(in) :: level 539 integer,optional,intent(in) :: line 540 character(len=*),intent(in) :: mode_paral 541 character(len=*),optional,intent(in) :: func 542 character(len=*),optional,intent(in) :: file 543 544 !Local variables------------------------------- 545 integer,save :: level_save=0 546 integer :: ii 547 integer :: f90line 548 character(len=500),save :: func_save 549 character(len=4) :: my_mode 550 character(len=10) :: lnum 551 character(len=500) :: my_func, my_file 552 character(len=500) :: msg 553 554 ! ********************************************************************* 555 556 ! initialize the variable 557 my_func = 'Function Unknown'; if (PRESENT(func)) my_func = basename(func) 558 my_file = "File Unknown"; if (PRESENT(file)) my_file = basename(file) 559 560 level_save=level; func_save=my_func 561 562 f90line=0; if (PRESENT(line)) f90line=line 563 564 if (toupper(mode_paral)=='COLL_SILENT'.or.toupper(mode_paral)=='PERS_SILENT') then 565 ! * Silent mode, check if we are inside a loop. 566 if (level==level_save .and. my_func==func_save) RETURN 567 ii = index( toupper(mode_paral), '_SILENT') 568 my_mode=toupper(mode_paral(1:ii-1)) 569 else ! * Normal mode. 570 my_mode=mode_paral 571 end if 572 573 if (my_mode/='COLL'.or.my_mode/='PERS') my_mode='COLL' 574 575 write(lnum,"(i0)")f90line 576 my_func= TRIM(my_func)//"@"//TRIM(my_file)//":"//TRIM(lnum) 577 578 if (level==1) then 579 msg = ' '//TRIM(my_func)//' >>>>> ENTER'//ch10 580 else if (level==2) then 581 msg = ' '//TRIM(my_func)//' >>>>> EXIT '//ch10 582 else 583 call die('Wrong level', & 584 & __FILE__,& 585 & __LINE__) 586 end if 587 588 call wrtout(std_out,msg,my_mode) 589 call flush_unit(std_out) 590 591 end subroutine sentinel
m_errors/set_backtrace_onerr [ Functions ]
[ Top ] [ m_errors ] [ Functions ]
NAME
set_backtrace_onerr
FUNCTION
1 to activate show_backtrace call in msg_hndl. 0 to disable it
SOURCE
780 subroutine set_backtrace_onerr(iflag) 781 782 !Arguments ------------------------------------ 783 integer,intent(in) :: iflag 784 ! ********************************************************************* 785 786 m_errors_show_backtrace = iflag 787 788 end subroutine set_backtrace_onerr
m_errors/show_backtrace [ Functions ]
[ Top ] [ m_errors ] [ Functions ]
NAME
show_backtrace
FUNCTION
shows a backtrace at an arbitrary place in user code. Program execution continues normally afterwards. The backtrace information is printed to the unit corresponding to ERROR_UNIT in ISO_FORTRAN_ENV. This is a (Gfortran extension| Ifort Extension)
SOURCE
805 subroutine show_backtrace() 806 807 #if defined FC_GNU && defined HAVE_FC_BACKTRACE 808 call backtrace() ! Gfortran extension 809 810 #elif defined FC_INTEL 811 call TRACEBACKQQ(USER_EXIT_CODE=-1) ! Ifort extension 812 #endif 813 814 end subroutine show_backtrace
m_errors/unused_ch [ Functions ]
[ Top ] [ m_errors ] [ Functions ]
NAME
unused_ch
FUNCTION
Helper function used to silence compiler warnings due to unused variables. Interfaced via the ABI_UNUSED macro.
INPUTS
var=Scalar character value
OUTPUT
None
SOURCE
1107 elemental subroutine unused_ch(var) 1108 1109 !Arguments ------------------------------------ 1110 character(len=*),intent(in) :: var 1111 1112 !Local variables------------------------------- 1113 character(len=LEN(var)) :: dummy 1114 ! ********************************************************************* 1115 1116 dummy = var 1117 1118 end subroutine unused_ch
m_errors/unused_cplx_dpc [ Functions ]
[ Top ] [ m_errors ] [ Functions ]
NAME
unused_cplx_dpc
FUNCTION
Helper function used to silence compiler warnings due to unused variables. Interfaced via the ABI_UNUSED macro.
INPUTS
var=Scalar complex value
OUTPUT
None
SOURCE
1013 elemental subroutine unused_cplx_dpc(var) 1014 1015 !Arguments ------------------------------------ 1016 complex(dpc),intent(in) :: var 1017 1018 !Local variables------------------------------- 1019 complex(dpc) :: dummy 1020 ! ********************************************************************* 1021 1022 dummy = var 1023 1024 end subroutine unused_cplx_dpc
m_errors/unused_cplx_spc [ Functions ]
[ Top ] [ m_errors ] [ Functions ]
NAME
unused_cplx_spc
FUNCTION
Helper function used to silence compiler warnings due to unused variables. Interfaced via the ABI_UNUSED macro.
INPUTS
var=Scalar complex value
OUTPUT
None
SOURCE
981 elemental subroutine unused_cplx_spc(var) 982 983 !Arguments ------------------------------------ 984 complex(spc),intent(in) :: var 985 986 !Local variables------------------------------- 987 complex(spc) :: dummy 988 ! ********************************************************************* 989 990 dummy = var 991 992 end subroutine unused_cplx_spc
m_errors/unused_int [ Functions ]
[ Top ] [ m_errors ] [ Functions ]
NAME
unused_int
FUNCTION
Helper function used to silence compiler warnings due to unused variables. Interfaced via the ABI_UNUSED macro.
INPUTS
var=Scalar integer value
OUTPUT
None
SOURCE
891 elemental subroutine unused_int(var) 892 893 !Arguments ------------------------------------ 894 integer,intent(in) :: var 895 896 !Local variables------------------------------- 897 integer :: dummy 898 ! ********************************************************************* 899 900 dummy = var 901 902 end subroutine unused_int
m_errors/unused_logical [ Functions ]
[ Top ] [ m_errors ] [ Functions ]
NAME
unused_logical
FUNCTION
Helper function used to silence compiler warnings due to unused variables. Interfaced via the ABI_UNUSED macro.
INPUTS
var=Scalar logical value
OUTPUT
None
SOURCE
1045 elemental subroutine unused_logical(var) 1046 1047 !Arguments ------------------------------------ 1048 logical,intent(in) :: var 1049 1050 !Local variables------------------------------- 1051 logical :: dummy 1052 ! ********************************************************************* 1053 1054 dummy = var 1055 1056 end subroutine unused_logical
m_errors/unused_logical1B [ Functions ]
[ Top ] [ m_errors ] [ Functions ]
NAME
unused_logical1B
FUNCTION
Helper function used to silence compiler warnings due to unused variables. Interfaced via the ABI_UNUSED macro.
INPUTS
var= 1 Byte Scalar logical value
OUTPUT
None
SOURCE
1075 elemental subroutine unused_logical1B(var) 1076 1077 !Arguments ------------------------------------ 1078 logical*1,intent(in) :: var 1079 1080 !Local variables------------------------------- 1081 logical :: dummy 1082 ! ********************************************************************* 1083 1084 dummy = var 1085 1086 end subroutine unused_logical1B
m_errors/unused_real_dp [ Functions ]
[ Top ] [ m_errors ] [ Functions ]
NAME
unused_real_dp
FUNCTION
Helper function used to silence warning messages due to unused variables. Interfaced via the ABI_UNUSED macro.
INPUTS
var=Scalar real value.
OUTPUT
None
SOURCE
923 elemental subroutine unused_real_dp(var) 924 925 !Arguments ------------------------------------ 926 real(dp),intent(in) :: var 927 928 !Local variables------------------------------- 929 real(dp) :: dummy 930 ! ********************************************************************* 931 932 dummy = var 933 934 end subroutine unused_real_dp
m_errors/unused_real_sp [ Functions ]
[ Top ] [ m_errors ] [ Functions ]
NAME
unused_real_sp
FUNCTION
Helper function used to silence compiler warnings due to unused variables. Interfaced via the ABI_UNUSED macro. Target: one-dimensional real(dp) vector.
SOURCE
949 elemental subroutine unused_real_sp(var) 950 951 !Arguments ------------------------------------ 952 real(sp),intent(in) :: var 953 954 !Local variables------------------------------- 955 real(sp) :: dummy 956 ! ********************************************************************* 957 958 dummy = var 959 960 end subroutine unused_real_sp
m_errors/xlf_set_sighandler [ Functions ]
[ Top ] [ m_errors ] [ Functions ]
NAME
xlf_set_sighandler
FUNCTION
Set the signal handler for IBM XLF
NOTES
See http://publib.boulder.ibm.com/infocenter/compbgpl/v9v111/index.jsp?topic=/com.ibm.xlf111.bg.doc/xlfopg/fptrap.htm The XL Fortran exception handlers and related routines are: xl__ieee Produces a traceback and an explanation of the signal and continues execution by supplying the default IEEE result for the failed computation. This handler allows the program to produce the same results as if exception detection was not turned on. xl__trce Produces a traceback and stops the program. xl__trcedump Produces a traceback and a core file and stops the program. xl__sigdump Provides a traceback that starts from the point at which it is called and provides information about the signal. You can only call it from inside a user-written signal handler. It does not stop the program. To successfully continue, the signal handler must perform some cleanup after calling this subprogram. xl__trbk Provides a traceback that starts from the point at which it is called. You call it as a subroutine from your code, rather than specifying it with the -qsigtrap option. It requires no parameters. It does not stop the program.
SOURCE
1190 subroutine xlf_set_sighandler() 1191 1192 ! ************************************************************************* 1193 1194 #ifdef FC_IBM 1195 call SIGNAL(SIGTRAP, xl__trcedump) 1196 call SIGNAL(SIGFPE, xl__trcedump) 1197 #endif 1198 1199 end subroutine xlf_set_sighandler