! netcdf_io.f90 - netCDF abstract I/O
! vi: set ts=8 sw=4:
! Copyright (C) TOYODA Eizi, 2000.  All rights reserved. 

module netcdf_io

    use netcdf_error
    use netcdf_v3
    use netcdf_variable
    use netcdf_slice
    implicit none

    private
    public:: get, get_text, get_int, get_real
    public:: put, put_text, put_int, put_real
    public:: NetcdfGetReal, NetcdfGetInt
    public:: NetcdfPutReal, NetcdfPutInt

    !
    ! --- 低レベル入出力 ---
    !
    ! * 1次元版: 1次元整合配列を引数にとり処理の成否 (論理型) を返す.
    ! *	7次元版: 7次元配列ポインタを返す. 廃止予定
    !

    interface get_text
	module procedure NetcdfGetText, get_text_7p
    end interface

    interface get_int
	module procedure NetcdfGetInt, get_int_7p
    end interface

    interface get_real
	module procedure NetcdfGetReal, get_real_7p
    end interface

    interface put_text
	module procedure NetcdfPutText
    end interface

    interface put_int
	module procedure NetcdfPutInt
    end interface

    interface put_real
	module procedure NetcdfPutReal
    end interface

    !
    ! 高レベル (任意次元配列入出力)
    !

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

    interface Put
	module procedure NetcdfPutReal1D
	module procedure NetcdfPutReal3D
	module procedure NetcdfPutReal7D
    end interface

contains

    !
    ! --- 低レベル入出力 (整合配列版) ---
    !

    ! buffer の大きさは size(limit) だけ存在しなくてはならない
    logical function NetcdfGetReal(var, buffer, buflen, limit) result(result)
	type(NC_VARIABLE), intent(in):: var
	integer, intent(in):: buflen
	real, intent(out):: buffer(buflen)
	type(NC_LIMIT), intent(in), optional:: limit
	type(NC_LIMIT):: mylimit
	integer:: stat
	integer, dimension(NC_SLICE_DIMS):: sta, cou, str
    continue
	if (present(limit)) then
	    mylimit = limit
	else
	    mylimit = WholeVariable(var)
	endif
	if (buflen < size(mylimit)) then
	    ! fake
	    call NetcdfSaveError(NF_ENOMEM, 'get_real', &
		& 'given buffer too small')
	    result = .FALSE.;  return
	endif
	sta = Start(mylimit)
	cou = Count(mylimit)
	if (.error. mylimit) then
	    result = .FALSE.;  return
	else if (size(mylimit) == 1) then
	    stat = nf_get_var1_real(var%file%id, var%id, sta, buffer(1))
	else if (.contiguous. mylimit) then
	    stat = nf_get_vara_real(var%file%id, var%id, sta, cou, buffer)
	else
	    str = Stride(mylimit)
	    stat = nf_get_vars_real(var%file%id, var%id, sta, cou, str, buffer)
	endif
	call NetcdfSaveError(stat, 'get_real', 'syscall')
	result = (stat == NF_NOERR)
    end function

    ! buffer の大きさは size(limit) だけ存在しなくてはならない
    logical function NetcdfGetInt(var, buffer, buflen, limit) result(result)
	type(NC_VARIABLE), intent(in):: var
	integer, intent(in):: buflen
	integer, intent(out):: buffer(buflen)
	type(NC_LIMIT), intent(in), optional:: limit
	type(NC_LIMIT):: mylimit
	integer:: stat
	integer, dimension(NC_SLICE_DIMS):: sta, cou, str
    continue
	if (present(limit)) then
	    mylimit = limit
	else
	    mylimit = WholeVariable(var)
	endif
	if (buflen < size(mylimit)) then
	    ! fake
	    call NetcdfSaveError(NF_ENOMEM, 'get_int', &
		& 'given buffer too small')
	    result = .FALSE.;  return
	endif
	sta = Start(mylimit)
	cou = Count(mylimit)
	if (.error. mylimit) then
	    result = .FALSE.;  return
	else if (size(mylimit) == 1) then
	    stat = nf_get_var1_int(var%file%id, var%id, sta, buffer(1))
	else if (.contiguous. mylimit) then
	    stat = nf_get_vara_int(var%file%id, var%id, sta, cou, buffer)
	else
	    str = Stride(mylimit)
	    stat = nf_get_vars_int(var%file%id, var%id, sta, cou, str, buffer)
	endif
	call NetcdfSaveError(stat, 'get_int', 'syscall')
	result = (stat == NF_NOERR)
    end function

    ! buffer の大きさは size(limit) だけ存在しなくてはならない
    logical function NetcdfGetText(var, buffer, buflen, limit) result(result)
	type(NC_VARIABLE), intent(in):: var
	integer, intent(in):: buflen
	character, intent(out), target:: buffer(buflen)
	type(NC_LIMIT), intent(in), optional:: limit
	type(NC_LIMIT):: mylimit
	integer:: stat
	integer, dimension(NC_SLICE_DIMS):: sta, cou, str
    continue
	if (present(limit)) then
	    mylimit = limit
	else
	    mylimit = WholeVariable(var)
	endif
	if (buflen < size(mylimit)) then
	    ! fake
	    call NetcdfSaveError(NF_ENOMEM, 'get_text', &
		& 'given buffer too small')
	    result = .FALSE.;  return
	endif
	sta = Start(mylimit)
	cou = Count(mylimit)
	if (.error. mylimit) then
	    result = .FALSE.;  return
	else if (size(mylimit) == 1) then
	    stat = nf_get_var1_text(var%file%id, var%id, sta, buffer(1))
	else if (.contiguous. mylimit) then
	    call get_contiguous(size(buffer))
	else
	    str = Stride(mylimit)
	    call get_stride(size(buffer))
	endif

	call NetcdfSaveError(stat, 'get_text', 'syscall')
	result = (stat == NF_NOERR)
    contains
	subroutine get_contiguous(bufsiz)
	    integer, intent(in):: bufsiz
	    character(len = bufsiz), pointer:: mybuffer
	continue
	    mybuffer => buffer(1)
	    stat = nf_get_vara_text(var%file%id, var%id, sta, cou, mybuffer)
	end subroutine

	subroutine get_stride(bufsiz)
	    integer, intent(in):: bufsiz
	    character(len = bufsiz), pointer:: mybuffer
	continue
	    mybuffer => buffer(1)
	    stat = nf_get_vars_text(var%file%id, var%id, sta, cou, &
		& str, mybuffer)
	end subroutine

!	    result = char_to_char_7array(buffer, shape(result))
    end function

    !
    ! --- 低レベル出力 ---
    !

    logical function NetcdfPutText(var, buf, buflen, limit) result(result)
	use dc_chars
	type(NC_VARIABLE), intent(in)::		var
	integer, intent(in)::			buflen
	character(len = *), intent(in)::	buf(buflen)
	type(NC_LIMIT), intent(in), optional::	limit
	type(NC_LIMIT)::			mylimit
	integer::				stat
    continue
	if (present(limit)) then
	    mylimit = limit
	else
	    mylimit = WholeVariable(var)
	endif
	if (.error. mylimit .or. buflen * len(buf) < size(mylimit)) then
	    result = .FALSE.; return
	endif
	stat = nf_put_vars_text(id(var%file), id(var), start(mylimit), &
	    & count(mylimit), stride(mylimit), char_array_to_char(buf))
	if (stat /= 0) then
	    result = .FALSE.; return
	endif
	result = .TRUE.
    end function

    logical function NetcdfPutInt(var, buffer, buflen, limit) result(result)
	type(NC_VARIABLE), intent(in)::		var
	integer, intent(in)::			buflen
	integer, intent(in)::			buffer(buflen)
	type(NC_LIMIT), intent(in), optional::	limit
	type(NC_LIMIT)::			mylimit
	integer::				stat
    continue
	if (present(limit)) then
	    mylimit = limit
	else
	    mylimit = WholeVariable(var)
	endif
	if (.error. mylimit .or. buflen < size(mylimit)) then
	    result = .FALSE.; return
	endif
	stat = nf_put_vars_int(id(var%file), id(var), start(mylimit), &
	    & count(mylimit), stride(mylimit), buffer)
	if (stat /= 0) then
	    call NetcdfSaveError(stat, 'put_int', id(var%file))
	    result = .FALSE.; return
	endif
	result = .TRUE.
    end function

    logical function NetcdfPutReal(var, buffer, buflen, limit) result(result)
	type(NC_VARIABLE), intent(in):: var
	integer, intent(in):: buflen
	real, intent(in):: buffer(buflen)
	type(NC_LIMIT), intent(in), optional:: limit
	type(NC_LIMIT):: mylimit
	integer:: stat
    continue
	if (present(limit)) then
	    mylimit = limit
	else
	    mylimit = WholeVariable(var)
	endif
	if (.error. mylimit .or. buflen < size(mylimit)) then
	    result = .FALSE.; return
	endif
	stat = nf_put_vars_real(id(var%file), id(var), &
	    & start(mylimit), count(mylimit), stride(mylimit), buffer)
	call NetcdfSaveError(stat, 'NetcdfPutReal', Fullname(var))
	if (stat /= 0) then
	    result = .FALSE.; return
	endif
	result = .TRUE.
    end function

    !
    ! --- 低レベル入力 ---
    !

    function get_text_7p(var, limit) result(result)
	character, pointer::			result(:, :, :, :, :, :, :)
	type(NC_VARIABLE), intent(in)::		var
	type(NC_LIMIT), intent(in), optional::	limit
	type(NC_LIMIT)::			mylimit
	integer::				stat
	integer, dimension(NC_SLICE_DIMS)::	d
    continue
	if (present(limit)) then
	    mylimit = limit
	else
	    mylimit = WholeVariable(var)
	endif
	if (.error. mylimit) then
	    nullify(result); return
	endif
	d = count(mylimit)
	allocate(result(d(1), d(2), d(3), d(4), d(5), d(6), d(7)), stat=stat)
	if (stat /= 0) then
	    nullify(result); return
	endif
	if (.not. NetcdfGetText(var, result, size(result), mylimit)) then
	    deallocate(result); return
	endif
    end function

    function get_int_7p(var, limit) result(result)
	integer, pointer::			result(:, :, :, :, :, :, :)
	type(NC_VARIABLE), intent(in)::		var
	type(NC_LIMIT), intent(in), optional::	limit
	type(NC_LIMIT)::			mylimit
	integer::				stat
	integer, dimension(NC_SLICE_DIMS)::	d, s
    continue
	if (present(limit)) then
	    mylimit = limit
	else
	    mylimit = WholeVariable(var)
	endif
	if (.error. mylimit) then
	    nullify(result); return
	endif
	d(:) = count(mylimit)
	s(:) = start(mylimit)
	d(:) = d(:) + s(:) - 1
	allocate(result(s(1):d(1), s(2):d(2), s(3):d(3), s(4):d(4), &
	    & s(5):d(5), s(6):d(6), s(7):d(7)), stat=stat)
	if (stat /= 0) then
	    call NetcdfSaveError(NF_ENOMEM, 'get_int', Fullname(var))
	    nullify(result); return
	endif
	if (.not. NetcdfGetInt(var, result, size(result), mylimit)) then
	    deallocate(result)
	    nullify(result)
	endif
    end function

    function get_real_7p(var, limit) result(result)
	real, pointer::				result(:, :, :, :, :, :, :)
	type(NC_VARIABLE), intent(in)::		var
	type(NC_LIMIT), intent(in), optional::	limit
	type(NC_LIMIT)::			mylimit
	integer::				stat
	integer, dimension(NC_SLICE_DIMS)::	d, s
    continue
	if (present(limit)) then
	    mylimit = limit
	else
	    mylimit = WholeVariable(var)
	endif
	if (.error. mylimit) then
	    nullify(result); return
	endif
	d(:) = count(mylimit)
	s(:) = start(mylimit)
	d(:) = d(:) + s(:) - 1
	allocate(result(s(1):d(1), s(2):d(2), s(3):d(3), s(4):d(4), &
	    & s(5):d(5), s(6):d(6), s(7):d(7)), stat=stat)
	if (stat /= 0) then
	    call NetcdfSaveError(NF_ENOMEM, 'get_real', Fullname(var))
	    nullify(result); return
	endif
	if (.not. NetcdfGetReal(var, result, size(result), mylimit)) then
	    deallocate(result)
	    nullify(result)
	endif
    end function

    !
    ! --- 高レベル入出力 ---
    !

    subroutine get_real_1(var, array, limit, fail)
	type(NC_VARIABLE), intent(in)::		var
	real, pointer::				array(:)
	type(NC_LIMIT), intent(in), optional::	limit
	logical, intent(out), optional::	fail
	logical:: ok
	integer:: lb(7), ub(7)
    continue
	lb(:) = 1
	ub(:) = Count(limit, var)
	allocate(array(lb(1): ub(1)))
	ok = NetcdfGetReal(var, array, size(array), limit)
	if (present(fail)) fail = .not. ok
    end subroutine

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

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

    subroutine NetcdfPutReal7D(var, array, limit, fail)
	type(NC_VARIABLE), intent(in)::		var
	real, intent(in)::			array(:, :, :, :, :, :, :)
	type(NC_LIMIT), intent(in), optional::	limit
	logical, intent(out), optional::	fail
	logical:: ok
    continue
	ok = NetcdfPutReal(var, array, size(array), limit)
	if (present(fail)) then
	    fail = .not. ok
	else
	    if (.not. ok) call NetcdfAssert
	endif
    end subroutine

    subroutine NetcdfPutReal3D(var, array, limit, fail)
	type(NC_VARIABLE), intent(in)::		var
	real, intent(in)::			array(:, :, :)
	type(NC_LIMIT), intent(in), optional::	limit
	logical, intent(out), optional::	fail
	logical:: ok
    continue
	ok = NetcdfPutReal(var, array, size(array), limit)
	if (present(fail)) then
	    fail = .not. ok
	else
	    if (.not. ok) call NetcdfAssert
	endif
    end subroutine

    subroutine NetcdfPutReal1D(var, array, limit, fail)
	type(NC_VARIABLE), intent(in)::		var
	real, intent(in)::			array(:)
	type(NC_LIMIT), intent(in), optional::	limit
	logical, intent(out), optional::	fail
	logical:: ok
    continue
	ok = NetcdfPutReal(var, array, size(array), limit)
	if (present(fail)) then
	    fail = .not. ok
	else
	    if (.not. ok) call NetcdfAssert
	endif
    end subroutine

end module
