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( '-------------- FATAL ERROR ----------------' )
22    ! only print file and line if line is positive
23    if (line > 0) then
24       if (use_html) then
25          call wrf_message( 'Fatal error in file: <A HREF="'// &
26             trim(documentation_url)//'/'//trim(html_file)//'">'//file_str// &
27             '</a>  LINE:  '//trim(line_str) )
28       else
29          call wrf_message( 'Fatal error in file:  '//trim(file_str)// &
30             '  LINE:  '//trim(line_str) )
31       end if
32    end if
33    do i=1,size(errors)
34       call wrf_message(errors(i))
35    end do
36    call wrf_message( '-------------------------------------------' )
37 #else
38    call wrf_message2( '-------------- FATAL ERROR ----------------' )
39    ! only print file and line if line is positive
40    if ( line > 0 ) then
41       if (use_html) then
42          call wrf_message( 'Fatal error in file: <A HREF="'// &
43             trim(documentation_url)//'/'//trim(html_file)//'">'// &
44             trim(file_str)//'</a>  LINE:  '//trim(line_str) )
45       else
46          call wrf_message2( 'Fatal error in file:  '//trim(file_str)// &
47             '  LINE:  '//trim(line_str) )
48       end if
49    end if
50    do i=1,size(errors)
51       call wrf_message(errors(i))
52    end do
53    call wrf_message2( '-------------------------------------------' )
54 #endif
55    call wrf_abort
56 end subroutine da_error
57 
58