root / src / Warning.f90 @ 10
Historique | Voir | Annoter | Télécharger (1,64 ko)
1 | 5 | pfleura2 | ! This routine prints a warning message and goes on |
---|---|---|---|
2 | 5 | pfleura2 | ! Inspired from Die in Siesta 3.1 |
3 | 5 | pfleura2 | SUBROUTINE Warning(routine, msg, file, line, unit) |
4 | 5 | pfleura2 | |
5 | 5 | pfleura2 | Use VarTypes |
6 | 5 | pfleura2 | Use io_module |
7 | 5 | pfleura2 | |
8 | 5 | pfleura2 | implicit none |
9 | 5 | pfleura2 | |
10 | 5 | pfleura2 | |
11 | 5 | pfleura2 | INTERFACE |
12 | 5 | pfleura2 | function valid(string) result (isValid) |
13 | 5 | pfleura2 | CHARACTER(*), intent(in) :: string |
14 | 5 | pfleura2 | logical :: isValid |
15 | 5 | pfleura2 | END function VALID |
16 | 5 | pfleura2 | |
17 | 5 | pfleura2 | END INTERFACE |
18 | 5 | pfleura2 | !--------------------------------------------------------------- Input Variables |
19 | 5 | pfleura2 | character(len=*), intent(in) :: routine, msg |
20 | 5 | pfleura2 | character(len=*), intent(in), optional :: file |
21 | 5 | pfleura2 | integer(KINT), intent(in), optional :: line, unit |
22 | 5 | pfleura2 | |
23 | 5 | pfleura2 | !--------------------------------------------------------------- Local Variables |
24 | 5 | pfleura2 | integer(KINT) :: warning_unit |
25 | 5 | pfleura2 | |
26 | 5 | pfleura2 | LOGICAL :: Debug |
27 | 5 | pfleura2 | |
28 | 5 | pfleura2 | !------------------------------------------------------------------------- BEGIN |
29 | 5 | pfleura2 | debug=valid('warning') |
30 | 5 | pfleura2 | |
31 | 5 | pfleura2 | if (debug) Call Header('Entering Warning') |
32 | 5 | pfleura2 | if (PRESENT(unit)) then |
33 | 5 | pfleura2 | warning_unit = unit |
34 | 5 | pfleura2 | else |
35 | 5 | pfleura2 | warning_unit = IOOUT |
36 | 5 | pfleura2 | endif |
37 | 5 | pfleura2 | |
38 | 5 | pfleura2 | write(warning_unit,'(a)') '*************************************************************' |
39 | 5 | pfleura2 | write(warning_unit,'(a)') '* WARNING *' |
40 | 5 | pfleura2 | write(warning_unit,'(a)') ' ' |
41 | 5 | pfleura2 | write(warning_unit,'(3a)') TRIM(routine), ': ', TRIM(msg) |
42 | 5 | pfleura2 | write(warning_unit,'(a)') ' ' |
43 | 5 | pfleura2 | if (PRESENT(file)) write(warning_unit,'(5x,2a)') 'File: ', file |
44 | 5 | pfleura2 | if (PRESENT(line)) write(warning_unit,'(5x,a,i5)') 'Line: ', line |
45 | 5 | pfleura2 | write(warning_unit,'(a)') '*************************************************************' |
46 | 5 | pfleura2 | |
47 | 5 | pfleura2 | if (debug) Call Header('Exiting Warning') |
48 | 5 | pfleura2 | |
49 | 5 | pfleura2 | END SUBROUTINE warning |