! vi: set ts=8 sw=4:

module gt3conv_vartable
    use gt3read
    use gtool
    use dc_string
    implicit none

    private
    public VARTABLE_ENTRY, UNITTABLE_ENTRY, units_table, vars_table, input
    public BuildVariableTable, DisposeVariableTable, NetcdfName

    type(GT3_FILE):: input
    type(VSTRING):: limit_item

    type VARTABLE_ENTRY
	integer:: first_unit
	type(VSTRING):: netcdf_name
	integer:: time_ord
!	type(NC_VARIABLE):: var
        ! NC_VARIABLE ̤ÄêµÁ
	! first header
	type(GT3_HEADER):: header
    end type

    integer, save:: num_vars = 0
    type(VARTABLE_ENTRY), save, pointer:: vars_table(:)

    type UNITTABLE_ENTRY
	integer:: var
	integer:: time
    end type

    integer, save:: num_units = 0
    type(UNITTABLE_ENTRY), save, pointer:: units_table(:)

contains

    type(VSTRING) function NetcdfName(namebase, revno) result(result)
	character(len = *), intent(in):: namebase
	integer, intent(in):: revno
	character(len = len(namebase)):: buffer
	character(len = *), parameter:: &
	    & Lowercase = 'abcdefghijklmnopqrstuvwxyz_-0123456789', &
	    & Uppercase = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
	integer:: i, j, k
	character:: c
    continue
	j = 0
	do, i = 1, len(namebase)
	    c = namebase(i: i)
	    if (c == ' ') cycle
	    k = index(Uppercase, c)
	    if (k > 0) then
		j = j + 1
		buffer(j: j) = Lowercase(k: k)
	    else if (index(Lowercase, c) > 0) then
		j = j + 1
		buffer(j: j) = c
	    endif
	enddo
	if (revno <= 0) then
	    result = buffer(1: j)
	else
	    result = buffer(1: j) // '-' // itos(revno)
	endif
    end function

    integer function LookupVariable(headers, header) result(result)
	type(GT3_HEADER), intent(in):: headers(:), header
    continue
	do, result = 1, num_vars
	    if (header%item /= headers(result)%item) cycle
	    if (all(header%axis_item == headers(result)%axis_item)) return
	enddo
	result = 0
    end function

    subroutine GiveUniqueName(vars_table, idx)
	type(VARTABLE_ENTRY), intent(inout):: vars_table(:)
	integer, intent(in):: idx
	type(VSTRING):: candidate
	integer:: i, n
    continue
NLOOP:	do, n = 0, 999
	    candidate = NetcdfName(vars_table(idx)%header%item, n)
	    do, i = 1, idx - 1
		if (vars_table(i)%netcdf_name == candidate) cycle NLOOP
	    enddo
	    vars_table(idx)%netcdf_name = candidate
	    return
	enddo NLOOP
	stop 'gt3conv_tool#GiveUniqueName detected too many variables'
    end subroutine

    integer function StoreVariable(header, cur_unit) result(result)
	type(GT3_HEADER), intent(in):: header
	integer, intent(in):: cur_unit
	type(VARTABLE_ENTRY), pointer:: vars_ptr(:)
	integer:: i
    continue
	num_vars = num_vars + 1
	result = num_vars
	if (result > size(vars_table)) then
	    allocate(vars_ptr(size(vars_table) * 2))
	    vars_ptr(1: size(vars_table)) = vars_table(:)
	    deallocate(vars_table)
	    vars_table => vars_ptr
	endif
	vars_table(result)%first_unit = cur_unit
	vars_table(result)%header = header
	call GiveUniqueName(vars_table, result)
    end function

    subroutine StoreUnitNumber(cur_unit, var_id, time)
	integer, intent(in):: cur_unit, var_id, time
	type(UNITTABLE_ENTRY), pointer:: units_ptr(:)
    continue
	num_units = max(cur_unit, num_units)
	if (cur_unit > size(units_table)) then
	    allocate(units_ptr(size(units_table) * 2))
	    units_ptr(1: size(units_table)) = units_table(:)
	    deallocate(units_table)
	    units_table => units_ptr
	endif
	units_table(cur_unit)%var = var_id
	units_table(cur_unit)%time = time
    end subroutine

    subroutine DisposeVariableTable
	limit_item = ''
	deallocate(units_table)
	deallocate(vars_table)
    end subroutine

    subroutine BuildVariableTable(input_file_item_name)
	type(VSTRING), intent(in):: input_file_item_name
	type(VSTRING):: fnam
	type(GT3_HEADER):: header
	type(UNITTABLE_ENTRY), pointer:: units_tmp(:)
	type(VARTABLE_ENTRY), pointer:: vars_tmp(:)
	logical:: eof
	integer:: cur_unit, var_id
    continue
	num_vars = 0
	num_units = 0
	limit_item = ''
	allocate(units_table(128))
	allocate(vars_table(4))

	call FilenameSplit(input_file_item_name, file=fnam, var=limit_item)
	call Open(input, char(fnam))
	cur_unit = 0
	do
	    call GetHeader(input, header, fail=eof)
	    if (eof) exit
	    cur_unit = cur_unit + 1

	    var_id = LookupVariable(vars_table(:)%header, header)
	    if (var_id == 0) then
		var_id = StoreVariable(header, cur_unit)
	    endif
	    call StoreUnitNumber(cur_unit, var_id, header%time)

	    call SkipRecord(input)
	enddo
	if (cur_unit == 0) then
	    print "('gt3conv: no data unit found')"
	    stop
	endif

	units_tmp => units_table
	allocate(units_table(1: num_units))
	units_table(:) = units_tmp(1: num_units)
	deallocate(units_tmp)

	vars_tmp => vars_table
	allocate(vars_table(1: num_vars))
	vars_table(:) = vars_tmp(1: num_vars)
	deallocate(vars_tmp)

    end subroutine

end module