! vi: set sw=4 ts=8:

module gt3conv_tools
    use gt3read
    use gtool
    implicit none

!    private
    public dims_table, vars_table

    type VARTABLE_ENTRY
	integer:: first_unit
	type(VSTRING):: netcdf_name
	integer:: time_ord
!	type(NC_VARIABLE):: var
        ! NC_VARIABLE 未定義
	type(GT3_HEADER):: header
    end type

    type(VARTABLE_ENTRY), save, allocatable:: vars_table(:)

    ! DIMTABLE_ENTRY : 次元変数に関する情報
    type DIMTABLE_ENTRY
	character(len = 30):: name    ! 軸の名前. lon, lat など
	character(len = 16):: item    ! 軸ファイルなら ITEM, ATIM?
	character(len = 16 * 2):: long_name ! 長い名前
	character(len = 16):: unit ! 単位
	integer:: lower, upper        ! ASTR1 と AEND1
	integer:: dim                 ! 軸の格子点数
	real, pointer:: values(:)     ! 例えば格子点値
    end type

    type(DIMTABLE_ENTRY), save, pointer:: dims_table(:)

contains

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

        ! 新しい変数を vars_table に格納する。もし未割り付けならば
	! 1 エントリだけ割り付ける。新しい vars_table の大きさを返す。
    integer function StoreVariable(header, cur_unit) result(result)
	type(GT3_HEADER), intent(in):: header
	integer, intent(in):: cur_unit
	type(VARTABLE_ENTRY), allocatable:: tmp_table(:)
	integer:: n
    continue
	if (.not. allocated(vars_table)) then
            allocate(vars_table(1))
	    result = 1
	else
            n = size(vars_table)
	    allocate(tmp_table(n))
	    tmp_table(1:n) = vars_table(1:n)
	    deallocate(vars_table)
            allocate(vars_table(n + 1))
	    vars_table(1:n) = vars_table(1:n)
	    result = n + 1
	endif
	vars_table(result)%first_unit = cur_unit
	vars_table(result)%header = header
	call GiveUniqueName(vars_table, result)
    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

    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) // '-' // char(revno)
	endif
    end function

    type(VSTRING) function AxisFilename(item, weight) result(result)
	character(len = 16), intent(in):: item
	logical, intent(in), optional:: weight
	character(len = *), parameter:: GTAXDIR_L = '/var/spool/gt3-dcl5/'
	character(len = *), parameter:: GTAXDIR_W = '/home/momoko/lib/gt3/'
	character(len = 8):: prefix
	logical:: exist
    continue
	print *, 'item=', trim(item)
	prefix = 'GTAXLOC.'
	if (present(weight)) then
	    if (weight) prefix = 'GTAXWGT.'
	endif
	result = prefix // trim(item)
	inquire(file=vchar(result,len(result)), exist=exist)
	if (exist) return
	result = GTAXDIR_L // prefix // trim(item)
	inquire(file=vchar(result,len(result)), exist=exist)
	if (exist) return
	result = GTAXDIR_W // prefix // trim(item)
	inquire(file=vchar(result,len(result)), exist=exist)
!	if (exist) return
!	result = GtoolGetenv('GTAXDIR') // prefix // trim(item)
!	inquire(file=vchar(result,len(result)), exist=exist)
!           環境変数の取り込みってどうやるの????
    end function


    subroutine ReadAxisFile(dim)
	type(DIMTABLE_ENTRY), intent(inout):: dim
	type(GT3_FILE):: axisfile
	type(GT3_HEADER):: header
	real, pointer:: buffer(:, :, :)
	integer:: lb, ub
    continue
	call Open(axisfile, &
                & vchar(AxisFilename(dim%item), len(AxisFilename(dim%item))))
	call Get(axisfile, header, buffer)
	call Close(axisfile)

	lb = lbound(buffer, 1)
	ub = ubound(buffer, 1)
	if (dim%lower < lb) then
	    print *, 'gt3conv#ReadAxisFile: requested lower bound ', &
		& dim%lower, ' is less than axis file value ', lb
	    stop
	endif
	if (dim%upper > ub) then
	    print *, 'gt3conv#ReadAxisFile: requested upper bound ', &
		& dim%upper, ' is greater than axis file value ', ub
	    stop
	endif
	allocate(dim%values(lb: ub))
	dim%values(:) = buffer(lb: ub, lbound(buffer, 2), lbound(buffer, 3))
        dim%long_name = header%title
	if (header%unit /= '') then
	    dim%unit = UnitString(header)
	endif
    end subroutine

    type(VSTRING) function Dimname3to4(item, usedname) result(result)
	character(len = *), intent(in):: item
	character(len = *), intent(in):: usedname(:)
	character(len = len(item)):: buffer
	type(VSTRING):: name, grids, suffix
	integer:: a, b, c
    continue
	buffer = adjustl(item)
	a = scan(buffer, '0123456789')
	name = buffer(1: a-1)
	b = verify(buffer(a: ), '0123456789')
	if (b == 0) b = len(buffer)
	grids = buffer(a: b)
	suffix = trim(buffer(b + 1: ))

	if (name == 'CSIG' .and. suffix == '.M') then
	    result = 'sigma_bound'
	else if (name == 'CSIG') then
	    result = 'sigma'
	else if (name == 'GLON') then
	    result = 'lon'
	else if (name == 'GGLA') then
	    result = 'lat'
	else
	    result = item
	endif
	if (all(usedname(:) /= vchar(result,len(result)))) return

	result = result // grids
	if (all(usedname(:) /= vchar(result,len(result)))) return

	name = result
	do, c = 1, huge(c)
	    result = name // char(c)
	    if (all(usedname(:) /= vchar(result,len(result)))) return
	enddo
	stop 'gt3conv#Dimname3to4'
    end function

    subroutine StoreDimension(header, ia)
        type(GT3_HEADER), intent(in):: header
        ! integer:: length
        integer, intent(in):: ia
        integer, save:: num_dims
	character(len = 16):: item
        integer:: idim
        type(DIMTABLE_ENTRY), pointer:: dims_tmp(:)
    continue
        ! 空なら飛ばす
	item = header%axis_item(ia)
	if (item == '') return

        ! 登録済みかどうかの確認
        do, idim = 1, num_dims
            if (item == dims_table(idim)%item) then
                 continue ! 上下端の確認くらいはするようにする.
                 return
            end if
        end do

        ! 未登録なら登録
        num_dims = num_dims +1
	    if (num_dims > size(dims_table)) then
		allocate(dims_tmp(size(dims_table) + 1))
                ! 豊田君のソースでは + 2 になってたけど....
		dims_tmp(1: size(dims_table)) = dims_table(:)
	        ! deallocate(dims_table)
                ! deallocate(dims_table) やってしまうとエラーになる.
		dims_table => dims_tmp
	    endif
        dims_table(num_dims)%item =  header%axis_item(ia)
        dims_table(num_dims)%lower =  header%axis_start(ia)
        dims_table(num_dims)%upper = header%axis_end(ia)
        dims_table(num_dims)%dim = dims_table(num_dims)%upper &
                 & - dims_table(num_dims)%lower + 1
   end subroutine

    type(VSTRING) function UnitString(header)
	type(GT3_HEADER), intent(in):: header
    continue
	if (header%unit == 'deg') then
	    if (header%item(1: 4) == 'GLON') then
		UnitString = 'degree_east'
	    else
		UnitString = 'degree_north'
	    endif
	else if (header%unit == '') then
            ! 無次元軸(sigma 等)の時は単位は空文字. 
            ! 本当にこれしか方法が無いんかな?
            UnitString = ' '
	else
	    UnitString = header%unit
	endif
    end function

end module