da_error.inc

1 subroutine da_error( file_str, line, errors)
2 
3    !-----------------------------------------------------------------------
4    ! Purpose: Standardised error reporting
5    !-----------------------------------------------------------------------
6 
7    implicit none
8 
9    character(len=*), intent(in) :: file_str
10    integer ,         intent(in) :: line  ! only print file and line if line > 0
11    character(len=*), intent(in) :: errors(:)
12    character*256 :: line_str
13    character*256 :: html_file
14    integer       :: i
15 
16    write(line_str,'(i6)') line
17 
18    html_file=file_str(1:LEN_trim(file_str)-4)//'.html'
19    
20 #if defined( DM_PARALLEL ) && ! defined( STUBMPI )
21    call wrf_message( &
22       '---------------------------- FATAL ERROR -----------------------' )
23    ! only print file and line if line is positive
24    if (line > 0) then
25       if (use_html) then
26          call wrf_message( 'Fatal error in file: <A HREF="'// &
27             trim(documentation_url)//'/'//trim(html_file)//'">'//file_str// &
28             '</a>  LINE:  '//trim(line_str) )
29       else
30          call wrf_message( 'Fatal error in file:  '//trim(file_str)// &
31             '  LINE:  '//trim(line_str) )
32       end if
33    end if
34    do i=1,size(errors)
35       call wrf_message(errors(i))
36    end do
37    call wrf_message( &
38       '----------------------------------------------------------------' )
39 #else
40    call wrf_message2( &
41       '---------------------------- FATAL ERROR -----------------------' )
42    ! only print file and line if line is positive
43    if ( line > 0 ) then
44       if (use_html) then
45          call wrf_message( 'Fatal error in file: <A HREF="'// &
46             trim(documentation_url)//'/'//trim(html_file)//'">'// &
47             trim(file_str)//'</a>  LINE:  '//trim(line_str) )
48       else
49          call wrf_message2( 'Fatal error in file:  '//trim(file_str)// &
50             '  LINE:  '//trim(line_str) )
51       end if
52    end if
53    do i=1,size(errors)
54       call wrf_message(errors(i))
55    end do
56    call wrf_message2( &
57       '----------------------------------------------------------------' )
58 #endif
59    call wrf_abort
60 end subroutine da_error
61 
62