TABLE OF CONTENTS


ABINIT/m_errors [ Modules ]

[ Top ] [ 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