1 | ! $Id: handle_err_m.F90 3065 2017-11-10 13:25:09Z adurocher $ |
---|
2 | module handle_err_m |
---|
3 | |
---|
4 | implicit none |
---|
5 | |
---|
6 | contains |
---|
7 | |
---|
8 | subroutine handle_err(message, ncerr, ncid, varid) |
---|
9 | |
---|
10 | use netcdf, only: nf90_strerror, nf90_noerr, nf90_close |
---|
11 | |
---|
12 | character(len=*), intent(in):: message |
---|
13 | ! (should include name of calling procedure) |
---|
14 | |
---|
15 | integer, intent(in):: ncerr |
---|
16 | |
---|
17 | integer, intent(in), optional :: ncid |
---|
18 | ! (Provide this argument if you want "handle_err" to try to close |
---|
19 | ! the file.) |
---|
20 | |
---|
21 | integer, intent(in), optional :: varid |
---|
22 | |
---|
23 | ! Variable local to the procedure: |
---|
24 | integer ncerr_close |
---|
25 | |
---|
26 | !------------------- |
---|
27 | |
---|
28 | if (ncerr /= nf90_noerr) then |
---|
29 | print *, message, ":" |
---|
30 | if (present(varid)) print *, "varid = ", varid |
---|
31 | print *, trim(nf90_strerror(ncerr)) |
---|
32 | if (present(ncid)) then |
---|
33 | ! Try to close, to leave the file in a consistent state: |
---|
34 | ncerr_close = nf90_close(ncid) |
---|
35 | ! (do not call "nf95_close", we do not want to recurse) |
---|
36 | if (ncerr_close /= nf90_noerr) then |
---|
37 | print *, "nf90_close:" |
---|
38 | print *, trim(nf90_strerror(ncerr_close)) |
---|
39 | end if |
---|
40 | end if |
---|
41 | call abort_physic("NetCDF95 handle_err", "", 1) |
---|
42 | end if |
---|
43 | |
---|
44 | end subroutine handle_err |
---|
45 | |
---|
46 | end module handle_err_m |
---|