! nc_error.f90 - object-oriented netCDF error interface (error)
! vi: set sw=4:
! Copyright (C) TOYODA Eizi, 2000.  All rights reserved.
!
! 2000-01-11 豊田英司	初版

module netcdf_error
    use netcdf_v3
    use iso_varying_string
    implicit none
    private

    public NC_ERROR, operator(.error.), operator(.eq.), &
	& assignment(=), Message, Assert, NetcdfAssert, NetcdfAbort, &
	& NetcdfSaveError, NetcdfLastError, NC_ERR, NetcdfClearError

    character(len=*), parameter:: RCSID = &
    & "$Id: netcdf_error.f90,v 1.6 2000/05/31 10:22:05 eizi Exp $"

    type NC_ERROR
	private
    	integer::			status
	type(VARYING_STRING)::		where, cause
    end type

    type(NC_ERROR), save:: nc_error_saved
    data nc_error_saved%status / NF_NOERR /

    interface operator(.error.)
	module procedure NetcdfErrorHappened
    end interface

    interface operator(.eq.)
	module procedure NetcdfEquivalentError
    end interface

    interface assignment(=)
	module procedure NetcdfSetErrorInt
    end interface

    interface Message
    	module procedure NetcdfMessageError
    end interface

    interface Assert
    	module procedure NetcdfAssertError
    end interface

    interface NetcdfAssert
    	module procedure NetcdfAssertError
    	module procedure NetcdfAssertLastError
    end interface

    interface NetcdfSaveError
	module procedure NetcdfSaveErrorInt
	module procedure NetcdfSaveErrorChar
	module procedure NetcdfSaveErrorString
	module procedure NetcdfSaveErrorNC_ERROR
    end interface

    interface NC_ERR
	module procedure NetcdfErrorCC
	module procedure NetcdfErrorCS
    end interface

contains

    type(NC_ERROR) function NetcdfErrorCC(status, where, cause) result(result)
	integer, intent(in)::			status
	character(len = *), intent(in)::	where, cause
    continue
	result = NC_ERROR(status, var_str(where), var_str(cause))
    end function

    type(NC_ERROR) function NetcdfErrorCS(status, where, cause) result(result)
	integer, intent(in)::			status
	character(len = *), intent(in)::	where
	type(VARYING_STRING), intent(in)::	cause
    continue
	result = NC_ERROR(status, var_str(where), cause)
    end function

    ! メッセージ印字に適した形式の文字列に変換
    function NetcdfMessageError(error) result(result)
	type(VARYING_STRING)::			result
    	type(NC_ERROR), intent(in)::		error
    continue
	result = ''
	if (len(error%where) > 0) then
	    result = '(' // error%where // ')'
	endif
	if (len(error%cause) > 0) then
	    result = result // ' ' // error%cause // ':'
	endif
	result = result // ' ' // trim(nf_strerror(error%status))
    end function

    logical function NetcdfErrorHappened(error)
    	type(NC_ERROR), intent(in)::	error
    continue
	NetcdfErrorHappened = (error%status /= NF_NOERR)
    end function

    logical function NetcdfEquivalentError(error, status)
    	type(NC_ERROR), intent(in)::	error
    	integer, intent(in)::			status
    continue
	NetcdfEquivalentError = (error%status == status)
    end function

    subroutine NetcdfAbort(string)
	use oslib
	type(VARYING_STRING), intent(in):: string
    continue
	call put_line(string)
	call DclAbort()
    end subroutine

    subroutine NetcdfAssertError(error)
    	type(NC_ERROR), intent(in)::	error
    continue
	if (.not..error. error) return
	call NetcdfAbort(Message(error))
    end subroutine

    subroutine NetcdfAssertLastError
	call NetcdfAssertError(NetcdfLastError())
    end subroutine

    subroutine NetcdfClearError
	nc_error_saved = 0
    end subroutine

    subroutine NetcdfSaveErrorChar(status, where, cause)
	integer, intent(in)::			status
	character(len=*), intent(in)::		where
	character(len=*)::			cause
    continue
	if (status == NF_NOERR) return
	nc_error_saved = NC_ERR(status, where, cause)
    end subroutine

    subroutine NetcdfSaveErrorString(status, where, cause)
	integer, intent(in)::			status
	character(len=*), intent(in)::		where
	type(VARYING_STRING)::			cause
    continue
	if (status == NF_NOERR) return
	nc_error_saved = NC_ERR(status, where, cause)
    end subroutine

    subroutine NetcdfSaveErrorInt(status, where, cause)
	integer, intent(in)::			status
	character(len=*), intent(in)::		where
	integer, intent(in)::			cause
	character(len=12)::			causechar
    continue
	if (status == NF_NOERR) return
	write(causechar, "(a, i8)") 'id: ', cause
	nc_error_saved = NC_ERR(status, where, causechar)
    end subroutine

    subroutine NetcdfSaveErrorNC_ERROR(error)
	type(NC_ERROR), intent(inout)::		error
    continue
	nc_error_saved = error
	error%where = ''
	error%cause = ''
    end subroutine

    subroutine NetcdfSetErrorInt(error, status)
    	type(NC_ERROR), intent(out)::	error
    	integer, intent(in)::			status
    continue
    	error%status = status
	error%where = ''
	error%cause = ''
    end subroutine

    type(NC_ERROR) function NetcdfLastError() result(result)
    continue
	result = nc_error_saved
    end function

end module
