! netcdf_slice.f90 - abstraction of partial array access
! vi: set sw=4 ts=8:
! Copyright (C) TOYODA Eizi, 2000.  All rights reserved.

! 説明
!
! netcdf_slice モジュールは netCDF ライブラリが提供する部分配列入出力の
! 抽象化である。ユーザは部分配列入出力の引数を指定して
! 引数に対応した netCDF ライブラリを呼び出す代わりに、
! NC_LIMIT 構造体を構成してこれを引数に渡して入出力を行う。
! 

module netcdf_slice

    use iso_varying_string
    use netcdf_v3
    use netcdf_file
    use netcdf_dimension
    use netcdf_variable
    implicit none
    private

    public:: NC_LIMIT, NC_SLICE, NC_SLICE_BODY, NC_SLICE_DIMS

    integer, parameter:: NC_SLICE_DIMS = 7

    ! dim 次元に関する部分読み取り指定。
    ! 最初の添字が start, 添字間隔 stride, 総数 count 個の要素を
    ! 読み取ろうとする。総数 size はイテレータに添字上限を知らせるために
    ! 利用される。添字下限は常に 1 である。
    ! 
    type NC_SLICE_BODY
	private
	type(NC_DIMENSION)::			dim
	! 範囲
	integer::				start, stride, count
	! イテレータ用
	integer::				size
    end type

    type NC_SLICE
	private
	type(NC_SLICE_BODY), pointer::		body
    end type

    type NC_LIMIT
	type(NC_SLICE_BODY), pointer::		slices(:)
	integer::				ndims
    end type

    public:: assignment(=), Slice, WholeVariable, operator(.error.)

    interface assignment(=)
	module procedure NetcdfLimitSetWholeVariable
	module procedure NetcdfSliceSetIndex
	module procedure NetcdfSliceSetList
    end interface

    interface Slice
	module procedure NetcdfSliceDimension
	module procedure NetcdfSliceDimensionOrd
	module procedure NetcdfSliceDimensionByName
	module procedure NetcdfSliceDimensionSetIndex
	module procedure NetcdfSliceDimensionOrdSetIndex
    end interface

    interface WholeVariable
	module procedure NetcdfLimitGetWholeVariable
    end interface

    interface operator(.error.)
	module procedure NetcdfLimitError
	module procedure NetcdfSliceError
    end interface

    public:: Dispose, Size, String, Count, Next, End, Start, Stride
    public:: operator(.contiguous.), DimensionsNumber

    interface Dispose; module procedure NetcdfLimitDispose; end interface
    interface Size
	module procedure NetcdfLimitSize, NetcdfSliceSize
    end interface
    interface String; module procedure NetcdfLimitString; end interface
    interface Count
	module procedure count_any, count_7, NetcdfSliceSize
	module procedure count_limit_or_var
    end interface
    interface Next; module procedure NetcdfLimitNext; end interface
    interface End; module procedure NetcdfSliceEnd; end interface
    interface Start
	module procedure NetcdfLimitStart
	module procedure NetcdfSliceStart
    end interface
    interface Stride
	module procedure NetcdfLimitStride
	module procedure NetcdfSliceStride
    end interface
    interface operator(.contiguous.)
	module procedure NetcdfLimitContiguous
    end interface
    interface DimensionsNumber
	module procedure limit_n_dims
    end interface

contains

    !
    ! --- Limit の作成と廃棄 ---
    !

    ! 総称名 WholeVariable
    function NetcdfLimitGetWholeVariable(var) result(result)
	type(NC_LIMIT)::			result
	type(NC_VARIABLE), intent(in)::		var
	type(NC_DIMENSION), pointer::		dims(:)
	integer::				i
    continue
	result%ndims = DimensionsNumber(var)
	if (result%ndims <= 0) then
	    nullify(result%slices);  return
	endif
	dims => Dimensions(var)
	allocate(result%slices(result%ndims))
	result%slices(:)%start = 1
	result%slices(:)%stride = 1
	result%slices(:)%dim = dims(:)
	result%slices(:)%size = len(dims(:))
	result%slices(:)%count = max(result%slices(:)%size, 1)
	deallocate(dims)
    end function

    ! 総称名 dispose
    subroutine NetcdfLimitDispose(limit)
	type(NC_LIMIT), intent(inout)::		limit
    continue
	if (limit%ndims == 0 .or. .not. associated(limit%slices)) return
	limit%ndims = 0
	deallocate(limit%slices)
	nullify(limit%slices)
    end subroutine

    !
    ! --- GENERIC Slice ---
    !

    function NetcdfSliceDimension(limit, dim) result(result)
	type(NC_SLICE)::			result
	type(NC_LIMIT), intent(in)::		limit
	type(NC_DIMENSION), intent(in)::	dim
	integer::		i
    continue
	if (.not. associated(limit%slices)) goto 999
	do, i = 1, limit%ndims
	    if (limit%slices(i)%dim == dim) then
		result%body => limit%slices(i)
		return
	    endif
	enddo
999	continue
	nullify(result%body)
    end function

    function NetcdfSliceDimensionOrd(limit, dimord) result(result)
	type(NC_SLICE)::			result
	type(NC_LIMIT), intent(in)::		limit
	integer, intent(in)::			dimord
	integer::		i
    continue
	if (.not. associated(limit%slices)) goto 999
	if (dimord > size(limit%slices)) goto 999
	result%body => limit%slices(dimord)
	return
999	continue
	nullify(result%body)
    end function

    function NetcdfSliceDimensionByName(limit, dimname) result(result)
	type(NC_SLICE)::			result
	type(NC_LIMIT), intent(in)::		limit
	character(len = *), intent(in)::	dimname
	type(NC_DIMENSION)::			dim
    continue
	if (.not. associated(limit%slices)) goto 999
	dim = Dimension(limit%slices(1)%dim%file, dimname)
	if (.error. dim) goto 999
	result = Slice(limit, dim)
	return
999	continue
	nullify(result%body)
	return
    end function

    logical function NetcdfSliceDimensionSetIndex(limit, dimname, start, &
    & stride, count) result(result)
	type(NC_LIMIT), intent(in)::		limit
	character(len = *), intent(in)::	dimname
	integer, intent(in)::			start
	integer, intent(in), optional::		stride, count
	type(NC_SLICE)::			it
    continue
	it = Slice(limit, dimname)
	if (.not. associated(it%body)) then
	    result = .FALSE.; return
	endif
	if (present(count) .and. present(stride)) then
	    it = (/start, count, stride/)
	else if (present(count)) then
	    it = (/start, count/)
	else
	    it = start
	endif
	result = .TRUE.
    end function

    logical function NetcdfSliceDimensionOrdSetIndex(limit, dimord, start, &
    & stride, count) result(result)
	type(NC_LIMIT), intent(in)::		limit
	integer, intent(in)::			dimord
	integer, intent(in)::			start
	integer, intent(in), optional::		stride, count
	type(NC_SLICE)::			it
    continue
	it = Slice(limit, dimord)
	if (.not. associated(it%body)) then
	    result = .FALSE.; return
	endif
	if (present(count) .and. present(stride)) then
	    it = (/start, count, stride/)
	else if (present(count)) then
	    it = (/start, count/)
	else
	    it = start
	endif
	result = .TRUE.
    end function

    !
    ! --- GENERIC ASSIGNMENT ---
    !

    ! 総称名 assignment(NC_LIMIT = NC_VARIABLE)
    subroutine NetcdfLimitSetWholeVariable(limit, var)
	type(NC_LIMIT), intent(inout)::		limit
	type(NC_VARIABLE), intent(in)::		var
    continue
	limit = WholeVariable(var)
    end subroutine

    ! 総称名 assignment(NC_SLICE = integer)
    subroutine NetcdfSliceSetIndex(slice, idx)
	type(NC_SLICE), intent(inout)::		slice
	integer, intent(in)::			idx
    continue
	if (.not. associated(slice%body)) return
	slice%body%start = idx
	slice%body%count = 1
    end subroutine

    ! 総称名 assignment(NC_SLICE = integer(:))
    subroutine NetcdfSliceSetList(slice, idx)
	type(NC_SLICE), intent(inout)::		slice
	integer, intent(in)::			idx(:)
	type(NC_SLICE_BODY), pointer::		body
    continue
	if (.not. associated(slice%body)) return
	body => slice%body
	body%start = 1
	if (size(idx) >= 1) body%start = idx(1)
	body%count = 1
	if (size(idx) >= 2) body%count = idx(2)
	if (body%count == 0) then
	    body%count = Len(body%dim)
	endif
	body%stride = 1
	if (size(idx) >= 3) body%stride = idx(3)
    end subroutine

    !
    ! --- ITERATOR ---
    !

    ! 総称名 next
    ! limit disposed when loop is done.
    !
    subroutine NetcdfLimitNext(limit)
	type(NC_LIMIT), intent(inout)::		limit
	integer::		i, upper
	type(NC_SLICE_BODY), pointer::		it
    continue
	if (.not. associated(limit%slices)) return
	do, i = 1, size(limit%slices)
	    it => limit%slices(i)
	    upper = it%start + it%stride * it%count
	    if (upper < it%size .or. it%size == 0) then
		it%start = upper + it%stride
		return
	    endif
	enddo
	call Dispose(limit)
    end subroutine

    !
    ! --- MISC. FUNCTION ---
    !

    ! 総称名 start
    integer function NetcdfSliceStart(slice) result(result)
	type(NC_SLICE), intent(in)::		slice
    continue
	if (.not. associated(slice%body)) then
	    result = 0; return
	endif
	result = slice%body%start
    end function

    ! 総称名 end
    integer function NetcdfSliceEnd(slice) result(result)
	type(NC_SLICE), intent(in)::		slice
    continue
	if (.not.associated(slice%body)) then
	    result = 1; return
	endif
	result = slice%body%start + slice%body%stride * slice%body%count
    end function

    ! 総称名 size
    integer function NetcdfSliceSize(slice) result(result)
	type(NC_SLICE), intent(in)::		slice
    continue
	if (.not.associated(slice%body)) then
	    result = 1; return
	endif
	result = slice%body%count
    end function

    ! 総称名 stride
    integer function NetcdfSliceStride(slice) result(result)
	type(NC_SLICE), intent(in)::		slice
    continue
	if (.not. associated(slice%body)) then
	    result = 1; return
	endif
	result = slice%body%stride
    end function

    ! 総称名 size
    integer function NetcdfLimitSize(limit) result(result)
	type(NC_LIMIT), intent(in)::		limit
	integer::		i, len
    continue
	if (.error. limit) then
	    result = 0; return
	endif
	if (limit%ndims == 0) then
	    result = 1; return
	endif
	result = 1
	do, i = 1, limit%ndims
	    len = limit%slices(i)%count
	    if (len < 0) then
		result = 0; return
	    endif
	    if (len == 0) len = 1
	    result = result * len
	enddo
    end function

    function NetcdfLimitString(limit) result(result)
	type(VARYING_STRING)::			result
	type(NC_LIMIT), intent(in)::		limit
	integer::				i
	character(len = 80)::			buf
    continue
	if (.error. limit) then
	    result = 'limit(error)'; return
	endif
	if (limit%ndims == 0) then
	    result = 'limit(scalar)'; return
	endif
	result = 'limit('
	do, i = 1, limit%ndims
	    write(unit=buf, fmt="('(', 3i4, ')')") limit%slices(i)%start, &
		& limit%slices(i)%count, limit%slices(i)%stride
	    result = result // trim(buf)
	enddo
	result = result // ')'
    end function

    ! 総称名 Count
    function count_any(limit, ndims) result(result)
	type(NC_LIMIT), intent(in)::	limit
	integer, intent(in):: 		ndims
	integer::			result(ndims), defined
    continue
	if (.not. associated(limit%slices)) then
	    result(:) = 1; return
	endif
	defined = min(ndims, limit%ndims)
	result(1: defined) = limit%slices(1: defined)%count
	if (defined < limit%ndims) &
	    result(defined) = product(limit%slices(defined: )%count)
	result(defined + 1: ) = 1
    end function

    function count_7(limit) result(result)
	type(NC_LIMIT), intent(in):: limit
	integer:: result(NC_SLICE_DIMS)
    continue
	result = Count(limit, NC_SLICE_DIMS)
    end function

    ! 総称名 Count
    function count_limit_or_var(limit, if_absent) result(result)
	integer:: result(NC_SLICE_DIMS)
	type(NC_LIMIT), intent(in), optional:: limit
	type(NC_VARIABLE), intent(in):: if_absent
    continue
	if (present(limit)) then
	    result = Count(limit, NC_SLICE_DIMS)
	else
	    result = Count(WholeVariable(if_absent), NC_SLICE_DIMS)
	endif
    end function

    function NetcdfLimitStart(limit) result(result)
	integer::				result(NC_SLICE_DIMS)
	type(NC_LIMIT), intent(in)::		limit
	integer::				defined
    continue
	if (.not. associated(limit%slices)) then
	    result(:) = 1; return
	endif
	defined = min(NC_SLICE_DIMS, size(limit%slices))
	result(1: defined) = limit%slices(1: defined)%start
	result(defined + 1: ) = 1
    end function

    function NetcdfLimitStride(limit) result(result)
	integer::				result(NC_SLICE_DIMS)
	type(NC_LIMIT), intent(in)::		limit
	integer::				defined
    continue
	if (.not. associated(limit%slices)) then
	    result(:) = 1; return
	endif
	defined = min(NC_SLICE_DIMS, size(limit%slices))
	result(1: defined) = limit%slices(1: defined)%stride
	result(defined + 1: ) = 1
    end function

    ! 総称名 operator(.error.)
    logical function NetcdfLimitError(limit) result(result)
	type(NC_LIMIT), intent(in)::		limit
	type(NC_SLICE_BODY), pointer:: sl(:)
    continue
	if (limit%ndims < 0 .or. limit%ndims > NF_MAX_DIMS) then
	    result = .TRUE.; return
	else if (limit%ndims == 0) then
	    result = .FALSE.; return
	endif
	if (.not. associated(limit%slices)) then
	    result = .TRUE.; return
	endif
	if (size(limit%slices) /= limit%ndims) then
	    result = .TRUE.; return
	endif

	sl => limit%slices(:)
	if (any(sl(:)%size < 0)) then
	    result = .TRUE.; return
	endif
	! 入出力が不可能な添字をつけてはいけない
	if (any((sl(:)%start < 1) .or. (sl(:)%stride < 1) .or. &
	    & (sl(:)%count < 1))) then
	    result = .TRUE.
	    return
	endif
	! 固定長なのに範囲を超えてはいけない
	result = any((sl(:)%size > 0) .and. &
	    & (sl%start + (sl%count - 1) * sl%stride > sl%size))
    end function

    ! 総称名 operator(.error.)
    logical function NetcdfSliceError(slice) result(result)
	type(NC_SLICE), intent(in)::		slice
	type(NC_SLICE_BODY), pointer:: it
    continue
	if (.not. associated(slice%body)) then
	    result = .TRUE.; return
	endif
	it => slice%body
	result = (it%size < 0 .or. it%start < 1 .or. it%start > it%size .or. &
	    & it%stride < 1 .or. it%count < 1 .or. &
	    & it%start + (it%count - 1) * it%stride > it%size)
    end function

    ! 総称名 operator(.contiguous.)
    logical function NetcdfLimitContiguous(limit) result(result)
	type(NC_LIMIT), intent(in)::		limit
    continue
	if (limit%ndims < 0) then
	    result = .FALSE.
	else if (limit%ndims == 0) then
	    result = .TRUE.
	else
	    result = all(limit%slices(:)%stride == 1)
	endif
    end function

    ! 総称名 DimensionsNumber
    integer function limit_n_dims(limit) result(result)
	type(NC_LIMIT), intent(in):: limit
    continue
	if (limit%ndims <= 0) then
	    result = limit%ndims
	else
	    result = count(limit%slices(:)%count > 1)
	endif
    end function

end module
