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

module gtool_io 

    use netcdf
    use gtool_variable
    use gtool_attribute
    use gtool_partial
    implicit none

    private
    public:: Get, GtoolGetReal
    public:: Put, GtoolPutReal

    interface Get
	module procedure get_real_1, get_real_2, get_real_3, get_real_7
    end interface

    interface Put
	module procedure put_real_1, put_real_2, put_real_3, put_real_7
    end interface

contains

    !
    ! --- 整合配列入出力 ---
    !

    logical function GtoolGetReal(var, buffer, buflen) result(result)
    	type(GT_VARIABLE), intent(in):: var
	integer, intent(in):: buflen
	real, intent(out):: buffer(buflen)
	integer:: i
	type(GT_ATTRIBUTE):: attr
	real:: factor, offset
    continue
	if (.hasVariable. var) then
	    result = NetcdfGetReal(var%ncvar, buffer, buflen)
	else if (.hasDimension. var) then
	    buffer = (/(real(i), i = 1, buflen)/)
	    result = .TRUE.
	else
	    call NetcdfAbort(var_str('GtoolGetReal'))
	endif
	attr = Attribute(var, 'scale_factor')
	if (.exists. attr) then
	    factor = attr
	    buffer(:) = buffer(:) * factor
	endif
	call Dispose(attr)
	attr = Attribute(var, 'add_offset')
	if (.exists. attr) then
	    offset = attr
	    buffer(:) = buffer(:) + offset
	endif
	call Dispose(attr)
    end function

    logical function GtoolPutReal(var, buffer, buflen) result(result)
    	type(GT_VARIABLE), intent(inout):: var
	integer, intent(in):: buflen
	real, intent(in):: buffer(buflen)
	real, pointer:: mybuffer(:)
	type(GT_ATTRIBUTE):: add_offset, scale_factor
	real:: factor, offset
    continue
	add_offset = Attribute(var, 'add_offset')
	scale_factor = Attribute(var, 'scale_factor')
	if (.exists. add_offset .or. .exists. scale_factor) then
	    allocate(mybuffer(buflen))
	    mybuffer(:) = buffer(:)
	    if (.exists. add_offset) then
		offset = add_offset
		mybuffer(:) = mybuffer(:) - offset
	    endif
	    if (.exists. scale_factor) then
		factor = scale_factor
		mybuffer(:) = mybuffer(:) / factor
	    endif
	    call Dispose(add_offset)
	    call Dispose(scale_factor)
	    call do_io(mybuffer)
	    deallocate(mybuffer)
	else
	    call do_io(buffer)
	endif
    contains
	subroutine do_io(buffer)
	    real, intent(in):: buffer(buflen)
	continue
	    if (.hasVariable. var) then
		call DataMode(var%ncvar%file)
		result = NetcdfPutReal(var%ncvar, buffer, buflen, var%nclimit)
	    else
		call NetcdfAbort(var_str('GtoolGetReal'))
	    endif
	end subroutine
    end function

    !
    ! --- ポインタ割付入出力 ---
    !

    subroutine get_real_1(var, array, fail)
	type(GT_VARIABLE), intent(in)::		var
	real, pointer::				array(:)
	logical, intent(out), optional::	fail
	logical:: ok
	integer:: ub(1)
    continue
	ub(:) = Count(var, 1)
	allocate(array(ub(1)))
	ok = GtoolGetReal(var, array, size(array))
	if (present(fail)) fail = .not. ok
    end subroutine

    subroutine get_real_2(var, array, fail)
	type(GT_VARIABLE), intent(in)::		var
	real, pointer::				array(:, :)
	logical, intent(out), optional::	fail
	logical:: ok
	integer:: ub(2)
    continue
	ub(:) = Count(var, 2)
	allocate(array(ub(1), ub(2)))
	ok = GtoolGetReal(var, array, size(array))
	if (present(fail)) fail = .not. ok
    end subroutine

    subroutine get_real_3(var, array, fail)
	type(GT_VARIABLE), intent(in)::		var
	real, pointer::				array(:, :, :)
	logical, intent(out), optional::	fail
	logical:: ok
	integer:: ub(3)
    continue
	ub(:) = Count(var, 3)
	allocate(array(ub(1), ub(2), ub(3)))
	ok = GtoolGetReal(var, array, size(array))
	if (present(fail)) fail = .not. ok
    end subroutine

    subroutine get_real_7(var, array, fail)
	type(GT_VARIABLE), intent(in)::		var
	real, pointer::				array(:, :, :, :, :, :, :)
	logical, intent(out), optional::	fail
	logical:: ok
	integer:: ub(7)
    continue
	ub(:) = Count(var, 7)
	allocate(array(ub(1), ub(2), ub(3), ub(4), ub(5), ub(6), ub(7)))
	ok = GtoolGetReal(var, array, size(array))
	if (present(fail)) fail = .not. ok
    end subroutine

    subroutine put_real_1(var, array, fail)
	type(GT_VARIABLE), intent(inout)::		var
	real, intent(in)::			array(:)
	logical, intent(out), optional::	fail
	logical:: ok
    continue
	ok = GtoolPutReal(var, array, size(array))
	if (present(fail)) then
	    fail = .not. ok
	else
	    if (.not. ok) call NetcdfAssert
	endif
    end subroutine

    subroutine put_real_2(var, array, fail)
	type(GT_VARIABLE), intent(inout)::		var
	real, intent(in)::			array(:, :)
	logical, intent(out), optional::	fail
	logical:: ok
    continue
	ok = GtoolPutReal(var, array, size(array))
	if (present(fail)) then
	    fail = .not. ok
	else
	    if (.not. ok) call NetcdfAssert
	endif
    end subroutine

    subroutine put_real_3(var, array, fail)
	type(GT_VARIABLE), intent(inout)::		var
	real, intent(in)::			array(:, :, :)
	logical, intent(out), optional::	fail
	logical:: ok
    continue
	ok = GtoolPutReal(var, array, size(array))
	if (present(fail)) then
	    fail = .not. ok
	else
	    if (.not. ok) call NetcdfAssert
	endif
    end subroutine

    subroutine put_real_7(var, array, fail)
	type(GT_VARIABLE), intent(inout)::		var
	real, intent(in)::			array(:, :, :, :, :, :, :)
	logical, intent(out), optional::	fail
	logical:: ok
    continue
	ok = GtoolPutReal(var, array, size(array))
	if (present(fail)) then
	    fail = .not. ok
	else
	    if (.not. ok) call NetcdfAssert
	endif
    end subroutine

end module
