! gtool_attribute.f90 - gtool4 file interface
! Copyright (C) by TOYODA Eizi, 2000.  All rights reserved.
! vi: set sw=4 ts=8:

module gtool_attribute 

    use netcdf
    use dc_string
    use gtool_file
    use gtool_variable
    implicit none

    !
    ! === GT_VARIABLE 構造体しか現れない改善インターフェイス ===
    !

    interface HasAttribute
	module procedure GtoolVariableHasAttribute
    end interface

    interface AttributeType
	module procedure GtoolVariableAttributeType
    end interface

    interface AttributeLength
	module procedure GtoolVariableAttributeLength
    end interface

    interface PutAttribute
	module procedure GtoolVariablePutAttributeChars
    end interface

    interface GetAttribute
	module procedure GtoolVariableGetAttributeString
    end interface

    !
    ! === GT_ATTRIBUTE 構造体を用いる netcdf 互換インターフェイス ===
    !

    type GT_ATTRIBUTE
	type(NC_ATTRIBUTE):: ncattr
    end type

    interface Attribute
	module procedure GtoolGlobalAttribute
	module procedure GtoolVariableAttribute
    end interface

    interface operator(.exists.)
	module procedure GtoolAttributeExists
    end interface

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

    interface assignment(=)
	module procedure GtoolAttributePutChars
	module procedure GtoolAttributePutString
	module procedure GtoolAttributePutIntArray
	module procedure GtoolAttributePutRealArray
	module procedure GtoolAttributePutReal
	module procedure GtoolAttributeGetString
	module procedure GtoolAttributeGetIntArray
	module procedure GtoolAttributeGetRealArray
	module procedure GtoolAttributeGetReal
    end interface

    interface Dispose; module procedure GtoolAttributeDispose; end interface
    interface Delete; module procedure GtoolAttributeDelete; end interface
    interface Rename; module procedure GtoolAttributeRename; end interface
    interface Len; module procedure GtoolAttributeLen; end interface
    interface Type; module procedure GtoolAttributeType; end interface

contains

    !
    ! === 改善インターフェイス ===
    !

    integer function GtoolVariableAttributeLength(var, name) result(result)
	type(GT_VARIABLE), intent(in):: var
	character(len = *), intent(in):: name
    continue
	result = Len(Attribute(var%ncvar, name))
    end function

    integer function GtoolVariableAttributeType(var, name) result(result)
	type(GT_VARIABLE), intent(in):: var
	character(len = *), intent(in):: name
    continue
	result = Type(Attribute(var%ncvar, name))
    end function

    logical function GtoolVariableHasAttribute(var, name) result(result)
	type(GT_VARIABLE), intent(in):: var
	character(len = *), intent(in):: name
    continue
	result = .exists. Attribute(var%ncvar, name)
    end function

    subroutine GtoolVariablePutAttributeChars(var, aname, string)
	type(GT_VARIABLE), intent(inout):: var
	character(len = *), intent(in):: aname
	character(len = *), intent(in):: string
	type(NC_VARIABLE):: nvar
	type(NC_ATTRIBUTE):: attr
    continue
	if (.hasVariable. var) then
	    call DefineMode(var%ncvar%file)
	    attr = Attribute(var%ncvar, aname)
	    attr = string
	else
	    stop 'attribute put to non-netcdf variable unsupported'
	endif
    end subroutine

    subroutine GtoolVariableGetAttributeString(var, name, string)
	type(GT_VARIABLE), intent(in):: var
	character(len = *), intent(in):: name
	type(VARYING_STRING), intent(out):: string
    continue
	string = Attribute(var%ncvar, name)
    end subroutine

    !
    ! === GT_ATTIBUTE インターフェイス ===
    !

    !
    ! --- コンストラクタ ---
    !
    ! コンストラクタが呼ばれた後も属性が存在するかどうかは不定.
    ! 属性の存在は .exists. 演算子で検査せよ
    !

    function GtoolGlobalAttribute(file, name) result(result)
	type(GT_ATTRIBUTE)::				result
	type(GT_FILE), intent(in)::			file
	character(len = *), intent(in)::		name
    continue
	result%ncattr = Attribute(file%ncfile, name)
    end function

    function GtoolVariableAttribute(var, name) result(result)
	type(GT_ATTRIBUTE)::				result
	type(GT_VARIABLE), intent(in)::			var
	character(len = *), intent(in)::		name
    continue
	result%ncattr = Attribute(var%ncvar, name)
    end function

    !
    ! --- デストラクタ --- 
    !

    subroutine GtoolAttributeDispose(attr)
	type(GT_ATTRIBUTE), intent(inout):: attr
    continue
	call Dispose(attr%ncattr)
    end subroutine

    !
    ! --- 入出力 ---
    !
    ! 将来的には属性値の型変換をここで行う予定
    !

    subroutine GtoolAttributeGetString(string, attr)
	type(VARYING_STRING), intent(out):: string
	type(GT_ATTRIBUTE), intent(in):: attr
    continue
	string = attr%ncattr
    end subroutine

    subroutine GtoolAttributeGetReal(a, attr)
	real, intent(out):: a
	type(GT_ATTRIBUTE), intent(in):: attr
	real:: array(1)
    continue
	array(:) = attr%ncattr
	a = array(1)
    end subroutine

    subroutine GtoolAttributeGetRealArray(a, attr)
	integer, intent(out):: a(:)
	type(GT_ATTRIBUTE), intent(in):: attr
    continue
	a = attr%ncattr
    end subroutine

    subroutine GtoolAttributeGetIntArray(i, attr)
	integer, intent(out):: i(:)
	type(GT_ATTRIBUTE), intent(in):: attr
    continue
	i = attr%ncattr
    end subroutine

    subroutine GtoolAttributePutChars(attr, string)
	type(GT_ATTRIBUTE), intent(out):: attr
	character(len = *), intent(in):: string
    continue
	attr%ncattr = string
    end subroutine

    subroutine GtoolAttributePutString(attr, string)
	type(GT_ATTRIBUTE), intent(out):: attr
	type(VARYING_STRING), intent(in):: string
    continue
	attr%ncattr = string
    end subroutine

    subroutine GtoolAttributePutReal(attr, a)
	type(GT_ATTRIBUTE), intent(out):: attr
	real, intent(in):: a
    continue
	attr%ncattr = (/a/)
    end subroutine

    subroutine GtoolAttributePutRealArray(attr, a)
	type(GT_ATTRIBUTE), intent(out):: attr
	real, intent(in):: a(:)
    continue
	attr%ncattr = a(:)
    end subroutine

    subroutine GtoolAttributePutIntArray(attr, i)
	type(GT_ATTRIBUTE), intent(out):: attr
	integer, intent(in):: i(:)
    continue
	attr%ncattr = i(:)
    end subroutine

    !
    ! --- 改名・削除 --- 
    !

    subroutine GtoolAttributeRename(attr, name, fail)
	type(GT_ATTRIBUTE), intent(inout):: attr
	character(len = *), intent(in):: name
	logical, intent(out), optional:: fail
    continue
	call Rename(attr%ncattr, name, fail=fail)
    end subroutine

    subroutine GtoolAttributeDelete(attr, fail)
	type(GT_ATTRIBUTE), intent(inout):: attr
	logical, intent(out), optional:: fail
    continue
	call Delete(attr%ncattr, fail=fail)
    end subroutine

    !
    ! --- 関数 ---
    !

    integer function GtoolAttributeLen(attr) result(result)
	type(GT_ATTRIBUTE), intent(in):: attr
    continue
	result = Len(attr%ncattr)
    end function

    integer function GtoolAttributeType(attr) result(result)
	type(GT_ATTRIBUTE), intent(in):: attr
    continue
	result = Type(attr%ncattr)
    end function

    logical function GtoolAttributeExists(attr) result(result)
	type(GT_ATTRIBUTE), intent(in):: attr
    continue
	result = .exists. (attr%ncattr)
    end function

    logical function GtoolAttributeError(attr) result(result)
	type(GT_ATTRIBUTE), intent(in):: attr
    continue
	result = .error. (attr%ncattr)
    end function

end module
