Line data Source code
1 : !=======================================================================
2 :
3 : ! Diagnostic information output during run
4 : !
5 : ! author: Tony Craig
6 :
7 : module icedrv_system
8 :
9 : use icedrv_kinds
10 : use icedrv_constants, only: nu_diag
11 : use icedrv_state, only: aice
12 : use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted
13 :
14 : implicit none
15 : private
16 : public :: icedrv_system_abort
17 :
18 : !=======================================================================
19 :
20 : contains
21 :
22 : !=======================================================================
23 : ! prints error information prior to aborting
24 :
25 0 : subroutine icedrv_system_abort(icell, istep, string, file, line)
26 :
27 : integer (kind=int_kind), intent(in), optional :: &
28 : icell , & ! indices of grid cell where model aborts
29 : istep , & ! time step number
30 : line ! line number
31 :
32 : character (len=*), intent(in), optional :: string, file
33 :
34 : ! local variables
35 :
36 : character(len=*), parameter :: subname='(icedrv_system_abort)'
37 :
38 0 : write(nu_diag,*) ' '
39 :
40 0 : call icepack_warnings_flush(nu_diag)
41 :
42 0 : write(nu_diag,*) ' '
43 0 : write(nu_diag,*) subname,' ABORTED: '
44 0 : if (present(file)) write (nu_diag,*) subname,' called from ',trim(file)
45 0 : if (present(line)) write (nu_diag,*) subname,' line number ',line
46 0 : if (present(istep)) write (nu_diag,*) subname,' istep =', istep
47 0 : if (present(icell)) write (nu_diag,*) subname,' i, aice =', icell, aice(icell)
48 0 : if (present(string)) write (nu_diag,*) subname,' string = ',trim(string)
49 0 : stop
50 :
51 0 : end subroutine icedrv_system_abort
52 :
53 : !=======================================================================
54 :
55 : end module icedrv_system
56 :
57 : !=======================================================================
|