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

module gtool_variable 

    use netcdf
    use gtool_file
    use dc_string
    implicit none
    private

    public:: GT_VARIABLE

    type GT_VARIABLE
	type(GT_FILE)::	gtfile
	integer:: class
	type(NC_VARIABLE):: ncvar
	type(NC_LIMIT):: nclimit
	type(NC_DIMENSION):: ncdim
    end type

    integer, parameter:: GT_VARIABLE_UNKNOWN = 0
    integer, parameter:: GT_VARIABLE_NETCDF = 1
    integer, parameter:: GT_VARIABLE_NETCDF_DIM = 2
    integer, parameter:: GT_VARIABLE_NETCDF_DIMVAR = 3

    public:: Dimension, operator(.hasVariable.), operator(.hasDimension.)
    public:: operator(.error.), Nc

    interface Dimension; module procedure var2dim; end interface
    interface Nc; module procedure nc_part; end interface
    interface operator(.error.); module procedure var_error; end interface

    interface DimensionsNumber; module procedure ndims; end interface 

    interface operator(.hasVariable.)
	module procedure has_variable
    end interface

    interface operator(.hasDimension.)
	module procedure has_dimension
    end interface

    public:: Create, Close, Open, Name, Fullname, Maxval, MinVal
    public:: FilenameSplit, FirstVariable

    interface Create
	module procedure create_dim, create_var
	module procedure create_dimc, create_varc
	module procedure create_dimf
    end interface
    interface Close; module procedure GtoolVariableClose; end interface
    interface Open; module procedure GtoolVariableOpen; end interface
    interface Name; module procedure GtoolVariableName; end interface
    interface Fullname; module procedure GtoolVariableFullname; end interface
    interface MaxVal; module procedure GtoolVariableMaxVal; end interface
    interface MinVal; module procedure GtoolVariableMinVal; end interface

contains

    logical function has_dimension(var) result(result)
	type(GT_VARIABLE), intent(in)::		var
    continue
	result = (var%class == GT_VARIABLE_NETCDF_DIM .or. &
	    & var%class == GT_VARIABLE_NETCDF_DIMVAR)
    end function

    logical function has_variable(var) result(result)
	type(GT_VARIABLE), intent(in)::		var
    continue
	result = (var%class == GT_VARIABLE_NETCDF .or. &
	    & var%class == GT_VARIABLE_NETCDF_DIMVAR)
    end function

    logical function var_error(var) result(result)
	type(GT_VARIABLE), intent(in)::		var
    continue
	result = .not. (var%class == GT_VARIABLE_NETCDF .or. &
	    & var%class == GT_VARIABLE_NETCDF_DIM .or. &
	    & var%class == GT_VARIABLE_NETCDF_DIMVAR) &
	    & .or. .error. var%gtfile
    end function

    type(NC_VARIABLE) function nc_part(var) result(result)
	type(GT_VARIABLE), intent(in)::		var
    continue
	if (.hasVariable. var) then
	    result = var%ncvar
	else
	    result = NC_VARIABLE_ERROR()
	endif
    end function

    subroutine FilenameSplit(fullname, file, var, attr)
	type(VARYING_STRING), intent(in)::	fullname
	type(VARYING_STRING), intent(out), optional::	file, var, attr
	type(VARYING_STRING):: varpart
	integer:: hash, colon
    continue
	hash = index(char(fullname), '#', back=.TRUE.)
	if (hash == 0) then
	    if (present(file)) file = fullname
	    if (present(var)) var = ''
	    if (present(attr)) attr = ''
	    return
	endif
	if (present(file)) file = extract(fullname, 1, hash - 1)
	varpart = extract(fullname, hash + 1)
	colon = index(varpart, ':')
	if (colon == 0) then
	    if (present(var)) var = varpart
	    if (present(attr)) attr = ''
	    varpart = ''
	    return
	endif
	if (present(var)) var = extract(varpart, 1, colon - 1)
	if (present(attr)) attr = extract(varpart, colon + 1)
	varpart = ''
    end subroutine

    !
    ! --- コンストラクタ ---
    !

    ! fake
    type(VARYING_STRING) function FirstVariable(file) result(result)
	type(GT_FILE), intent(in)::		file
	integer:: i
	type(NC_VARIABLE):: v
    continue
    	do, i = 1, VariablesNumber(file%ncfile)
	    v = Variable(file%ncfile, i)
	    result = Name(v)
	    if (.error. Dimension(file%ncfile, char(result))) then
		call NetcdfClearError()
		return
	    endif
	enddo
	v = Variable(file%ncfile, 1)
	result = Name(v)
    end function

    subroutine create_dimc(var, fullname, length, fail)
	type(GT_VARIABLE), intent(out):: var
	character(len = *), intent(in):: fullname
	integer, intent(in):: length
	logical, intent(out), optional:: fail
    continue
	call create_dim(var, var_str(fullname), length, fail)
    end subroutine

    subroutine create_dim(var, fullname, length, fail)
	type(GT_VARIABLE), intent(out):: var
	type(VARYING_STRING), intent(in):: fullname
	integer, intent(in):: length
	logical, intent(out), optional:: fail
	logical:: myfail
	type(GT_FILE):: file
	type(VARYING_STRING):: filename, varname
    continue
	call FilenameSplit(fullname, filename, varname)
	call Open(file, filename, fail=myfail, writable=.TRUE.)
	if (myfail) then
	    call NetcdfClearError()
	    call Create(file, filename, fail=myfail)
	endif
	if (myfail) then
	    if (present(fail)) then
		var%class = GT_VARIABLE_UNKNOWN
		fail = .TRUE.
	    else
		call NetcdfAssert()
	    endif
	    return
	endif
	if (varname == '') varname = 'dim' // itos(length)
	call create_dimf(var, file, char(varname), length, fail)
    end subroutine

    subroutine create_dimf(var, file, varname, length, fail)
	type(GT_VARIABLE), intent(out):: var
	type(GT_FILE), intent(inout):: file
	character(len = *), intent(in):: varname
	integer, intent(in):: length
	logical, intent(out), optional:: fail
    continue
	var%gtfile = file
	var%ncdim = Dimension(file%ncfile, varname, length)
	if (.error. var%ncdim) goto 999
	var%ncvar = Variable(file%ncfile, varname, NF_FLOAT, (/var%ncdim/))
	if (.error. var%ncvar) goto 999
	var%nclimit = WholeVariable(var%ncvar)
	if (.error. var%nclimit) goto 999
	var%class = GT_VARIABLE_NETCDF_DIMVAR
	if (present(fail)) fail = .FALSE.
	return
    999 continue
	if (.not. present(fail)) then
	    call NetcdfAssert()
	    stop 'create_dimf'
	endif
	var%class = GT_VARIABLE_UNKNOWN
	fail = .TRUE.
    end subroutine

    subroutine create_varc(var, fullname, dims, fail)
	type(GT_VARIABLE), intent(out):: var
	character(len = *), intent(in):: fullname
	type(GT_VARIABLE), intent(in):: dims(:)
	logical, intent(out), optional:: fail
    continue
	call create_var(var, var_str(fullname), dims, fail)
    end subroutine

    subroutine create_var(var, fullname, dims, fail)
	type(GT_VARIABLE), intent(out):: var
	type(VARYING_STRING), intent(in):: fullname
	type(GT_VARIABLE), intent(in):: dims(:)
	logical, intent(out), optional:: fail
	type(VARYING_STRING):: filename, varname
	logical:: myfail
    continue
	call FilenameSplit(fullname, filename, varname)
	call Open(var%gtfile, filename, fail=myfail, writable=.TRUE.)
	if (myfail) goto 999
	var%ncvar = Variable(var%gtfile%ncfile, char(varname), NF_FLOAT, &
	    & dims(:)%ncdim)
	if (.error. var%ncvar) goto 999
	var%nclimit = WholeVariable(var%ncvar)
	if (.error. var%nclimit) goto 999
	var%class = GT_VARIABLE_NETCDF
	if (present(fail)) fail = .FALSE.
	return
    999 continue
	if (present(fail)) then
	    fail = .TRUE.
	else
	    call NetcdfAssert()
	endif
    end subroutine

    subroutine GtoolVariableOpen(var, fullname, writable, fail)
	type(GT_VARIABLE), intent(inout):: var
	type(VARYING_STRING), intent(in):: fullname
	logical, intent(in), optional:: writable
	logical, intent(out), optional:: fail
	type(VARYING_STRING):: filename, varname
	logical:: myfail
    continue
	call FilenameSplit(fullname, filename, varname)
	call Open(var%gtfile, filename, fail=myfail, writable=writable)
	if (myfail) goto 999
	if (varname == '') varname = FirstVariable(var%gtfile)
	var%ncvar = Variable(var%gtfile%ncfile, char(varname))
	if (.error. var%ncvar) goto 999
	var%nclimit = WholeVariable(var%ncvar)
	if (.error. var%nclimit) goto 999
	var%class = GT_VARIABLE_NETCDF
	if (present(fail)) fail = .FALSE.
	return
	! 失敗の場合
999	continue
	var%class = GT_VARIABLE_UNKNOWN
	if (present(fail)) then
	    fail = myfail
	else
	    call NetcdfAssert()
	endif
    end subroutine

    function ndims(var) result(result)
	integer:: result
	type(GT_VARIABLE), intent(in):: var
    continue
    	result = DimensionsNumber(var%ncvar)
    end function

    function var2dim(var, dim_ord) result(result)
	type(GT_VARIABLE):: result
	type(GT_VARIABLE), intent(in):: var
	integer, intent(in):: dim_ord
	type(NC_DIMENSION), pointer:: alldims(:)
    continue
	alldims => Dimensions(var%ncvar)
	if (.not. associated(alldims)) then
	    result%class = GT_VARIABLE_UNKNOWN
	    result%ncdim = NC_DIMENSION_ERROR()
	    result%gtfile = NC_FILE_ERROR
	    return
	endif
	call Open(result%gtfile, var%gtfile)
	result%ncvar = Variable(var%ncvar%file, char(Name(alldims(dim_ord))))
	result%ncdim = alldims(dim_ord)
	if (.not. .error. result%ncvar) then
	    result%nclimit = WholeVariable(result%ncvar)
	    result%class = GT_VARIABLE_NETCDF_DIMVAR
	else
	    result%class = GT_VARIABLE_NETCDF_DIM
	endif
	deallocate(alldims)
    end function

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

    subroutine GtoolVariableClose(var, fail)
	type(GT_VARIABLE), intent(inout)::		var
	logical, optional, intent(out):: fail
	logical:: myfail
    continue
	if (.error. var) then
	    if (present(fail)) then
		fail = .TRUE.;  return
	    else
		print "('Close: invalid GT_VARIABLE handle')";  stop
	    endif
	endif
	call Close(var%gtfile, fail=fail)
	var%class = GT_VARIABLE_UNKNOWN
    end subroutine
    
    !
    ! --- その他の関数 ---
    !

    type(VARYING_STRING) function GtoolVariableName(var) result(result)
	type(GT_VARIABLE), intent(in):: var
    continue
	if (.hasVariable. var) then
	    result = Name(var%ncvar)
	else if (.hasDimension. var) then
	    result = Name(var%ncdim)
	else
	    result = ''
	endif
    end function

    type(VARYING_STRING) function GtoolVariableFullname(var) result(result)
	type(GT_VARIABLE), intent(in):: var
    continue
	if (.hasVariable. var) then
	    result = Fullname(var%ncvar)
    	else if (.hasDimension. var) then
	    result = Fullname(var%ncdim)
	else
	    result = ''
	endif
    end function

    real function GtoolVariableMaxVal(var) result(result)
	type(GT_VARIABLE), intent(in):: var
	real, pointer:: buffer(:, :, :, :, :, :, :)
    continue
	if (.hasVariable. var) then
	    buffer => get_real(var%ncvar)
	    if (.not.associated(buffer)) then
		result = 1.0; return
	    endif
	    result = maxval(buffer)
	    deallocate(buffer)
	else if (.hasDimension. var) then
	    result = len(var%ncdim)
	else
	    result = 0
	endif
    end function

    real function GtoolVariableMinVal(var) result(result)
	type(GT_VARIABLE), intent(in):: var
	real, pointer:: buffer(:, :, :, :, :, :, :)
    continue
	if (.hasVariable. var) then
	    buffer => get_real(var%ncvar)
	    if (.not.associated(buffer)) then
		result = 0;  return
	    endif
	    result = minval(buffer)
	    deallocate(buffer)
	else if (.hasDimension. var) then
	    result = 1
	else
	    result = 0
	endif
    end function

end module
