Statistiques
| Révision :

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