nc_check.F90

Go to the documentation of this file.

!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!
!  Module :  n c _ c h e c k
!
!> @file
!!
!! NetCDF error capturing.
!!
!! @section Copyright
!!
!! Copyright 2009-2013 Ralf Greve
!!
!! @section License
!!
!! This file is part of SICOPOLIS.
!!
!! SICOPOLIS is free software: you can redistribute it and/or modify
!! it under the terms of the GNU General Public License as published by
!! the Free Software Foundation, either version 3 of the License, or
!! (at your option) any later version.
!!
!! SICOPOLIS is distributed in the hope that it will be useful,
!! but WITHOUT ANY WARRANTY; without even the implied warranty of
!! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!! GNU General Public License for more details.
!!
!! You should have received a copy of the GNU General Public License
!! along with SICOPOLIS.  If not, see <http://www.gnu.org/licenses/>.
!<
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

!-------------------------------------------------------------------------------
!> NetCDF error capturing.
!<------------------------------------------------------------------------------
module nc_check

use sico_types
use netcdf

contains

!-------------------------------------------------------------------------------
!> NetCDF error capturing.
!<------------------------------------------------------------------------------
subroutine check(status, ch_calling_routine)

implicit none

integer(i4b),                intent(in) :: status
character(len=64), optional, intent(in) :: ch_calling_routine

character(len=64)  :: ch_clrt

if ( present(ch_calling_routine) ) then
   ch_clrt = trim(ch_calling_routine)
else
   ch_clrt = 'topography3_nc'   ! default calling routine
end if

if (status /= nf90_noerr) then 
   write(6,'(1x,a)') trim(nf90_strerror(status))
   write(6,'(1x,a)') ' '//trim(ch_clrt)//': Stopped due to NetCDF error!'
   stop 
end if

end subroutine check  

end module nc_check  
!