program gt3conv

    use gtool, only: string, gtargcount, gtargget, abortprogram
    use gtool_history, only: gt_history_axis, HistoryCreate, &
        & historyClose, gt_history_varinfo, HistoryAddVariable, &
        & historyPut, HistorySetTime, HistoryAddAttr
    use dc_trace, only: setdebug
    use gt3map

implicit none

    integer:: i, iostat, ndims
    character(len = string):: arg, input
    character(len = string):: output = ""
    type(gt3_map):: map
    type(gt_history_axis), allocatable:: axis(:)
    type(gt_history_varinfo):: varinfo

    integer:: verbose = 2
    logical:: explicit_valid_range = .false.

continue

    ! 引数の読み込み(最後の引数がファイル名)
    do, i = 1, GtArgCount()
        call GtArgGet(i, arg)
        if (arg == '-debug') then
            call setdebug
        else if (arg(1:2) == '-h') then
            goto 900
        else if (arg(1:2) == '-q') then
            verbose = verbose - 1
        else if (arg(1:2) == '-v') then
            verbose = verbose + 1
        else if (arg(1:6) == '-valid') then
            explicit_valid_range = .true.
        else if (arg(1:4) == 'out=') then
            output = arg
        else
            input = arg
        endif
    enddo
    if (output == "") output = OutputFilename(input, ".nc")

    if (verbose > 0) then
        write(*, fmt='(A)') &
            & "gt3conv: from " // trim(input) // " to " // trim(output)
    endif
    call open(map, input, iostat)
    if (iostat /= 0) goto 900

    allocate(axis(map%n_axes))
    call get_axis(map, axis)
    call HistoryCreate(trim(output), trim(map%title), &
        & trim(map%source), trim(map%institution), &
        & axis, origin=0.0, interval=0.0)

    ! データ変数の作成
    do, i = 1, map%n_vars
        call get_variable(map, "VAR", i, varinfo)
        call HistoryAddVariable(varinfo)
        call make_attr(map, "VAR", i)
    enddo
    ! 大域属性は 1 つ変数を作った後で (gtool_history のバグ)
    call HistoryAddAttr("", "history", trim(map%history))

    ! 軸重み変数の作成
    do, i = 1, map%n_axes - 1
        call make_attr(map, "AXI", i)
        call get_variable(map, "WGT", i, varinfo)
	if (varinfo%name == '') cycle
        call HistoryAddVariable(varinfo)
        call make_attr(map, "WGT", i)
    enddo

    ! 軸変数の値を作成
    do, i = 1, map%n_axes - 1
        call HistoryPut(map%axistab(i)%name, map%axistab(i)%value)
	if (.not. associated(map%axistab(i)%name_w)) cycle
        call HistoryPut(map%axistab(i)%name_w, map%axistab(i)%value_w)
    enddo

    ! 時間軸をいったん全部書き込み
    do, i = 1, map%n_times
        call HistoryPut(map%axistab(map%n_axes)%name, map%timetab(i)%time)
    enddo

    ! データ変数の中身を読み書き
    call history_copy(map)

    call HistoryClose()
    call close(map, iostat)
    if (iostat /= 0) goto 900
    stop

900 continue
    print *, "error ", iostat
    print *, "usage: gt3conv [-debug] [out=output] input"
    call abortprogram("")

contains

    subroutine make_attr(map, class, order)
        use gt3read, only: gt3_header
    implicit none
        type(gt3_map), intent(in):: map
        character(len = *):: class
        integer, intent(in):: order
        type(gt3_header):: header
        character(len = token):: varname
        character(len = string):: comment
        integer:: i
    continue
        call getHeader(map, class, order, header, varname)
        if (class == 'AXI') then
            ! 軸重み
            if (associated(map%axistab(order)%name_w)) then
                call HistoryAddAttr(varname, "gt_calc_weight", &
                    & trim(map%axistab(order)%name_w))
            endif
            if (header%dataset(1:1) == 'C') then
                if (size(map%axistab(order)%value) > header%record_size / 2) then
                    call HistoryAddAttr(varname, "topology", &
                        & "circular")
                endif
                call HistoryAddAttr(varname, "modulo", map%axistab(order)%range)
            endif
        endif
        ! 何に使うのだろう... もうちょっと考えたほうがよい
        call HistoryAddAttr(varname, &
            & "gt_user_gtool3_tdur", header%time_duration)
        ! 欠損値
        call HistoryAddAttr(varname, "missing_value", &
            & header%missing_value)
        call HistoryAddAttr(varname, "_FillValue", &
            & header%missing_value)
        ! とてもお勧めできるとは思えない
        if (explicit_valid_range) then
            if (header%missing_value > 0) then
               call HistoryAddAttr(varname, "valid_max", &
                    & header%missing_value * (1.0 - epsilon(1.0)))
            else
                call HistoryAddAttr(varname, "valid_min", &
                    & header%missing_value * (1.0 - epsilon(1.0)))
            endif
        endif
        ! 描画範囲
        if (header%range_min /= header%range_max) then
            call HistoryAddAttr(varname, &
                & "gt_graph_range", (/header%range_min, header%range_max/))
        endif
        ! コンター間隔関係設定
        if (header%div_small /= 0.0) then
            call HistoryAddAttr(varname, &
                & "gt_graph_smalltick_interval", header%div_small)
            call HistoryAddAttr(varname, &
                & "gt_graph_contours_interval", header%div_small)
        endif
        if (header%div_large /= 0.0) then
            call HistoryAddAttr(varname, &
                & "gt_graph_tick_interval", header%div_large)
            call HistoryAddAttr(varname, &
                & "gt_graph_contours_thick_interval", header%div_large)
        endif
        ! 軸投影関係設定
        if (abs(header%scaling) == 2) then
            call HistoryAddAttr(varname, "gt_graph_logscale", "yes")
        endif
        if (header%scaling > 0) then
            call HistoryAddAttr(varname, "positive", "up")
        else
            call HistoryAddAttr(varname, "positive", "down")
        endif
        ! 予約欄
        if (header%option(1) /= "") then
            call HistoryAddAttr(varname, "gt_user_gtool3_optn1", &
                & trim(header%option(1)))
        endif
        if (header%option(2) /= "") then
            call HistoryAddAttr(varname, "gt_user_gtool3_optn2", &
                & trim(header%option(2)))
        endif
        if (header%option(3) /= "") then
            call HistoryAddAttr(varname, "gt_user_gtool3_optn3", &
                & trim(header%option(3)))
        endif
        ! コメント欄
        comment = ""
        do, i = 1, 12
            comment = trim(comment) // " " // trim(header%memo(i))
        enddo
        if (comment /= "") then
            call HistoryAddAttr(varname, "comment", trim(comment))
        endif
    end subroutine

    subroutine history_copy(map)
        use gt3read, only: gt3_header, getunit
    implicit none
        type(gt3_map):: map
        type(gt3_header):: header
        real, pointer:: buffer(:, :, :)
        integer:: iostat, irec
        type(unitlist_t), pointer:: ulist
    continue
        irec = 0
        ulist => map%unit%prev
        do
            irec = irec + 1
            call GetUnit(map%file, header, buffer, iostat)
            if (iostat /= 0) return
            ! 格子不整合で invalid になる場合除去
            ulist => ulist%next
            if (.not. ulist%valid) cycle
            ! いざ書き出し
            call HistorySetTime(real(header%time))
            call HistoryPut(varname_3to4(map, header%item), buffer)
            if (verbose > 1) then
                write(*, fmt='(A,I6,"/",I6)') &
                    achar(27) // '[A', irec, map%n_units
            endif
        enddo
    end subroutine

    function OutputFilename(src, suffix) result(result)
        character(len = string):: result
        character(len = *), intent(in):: src, suffix
        character(len = *), parameter:: pathdelim = ':/' // achar(92)
        character(len = *), parameter:: ANS = "ABCDEFGHIJKLMNOPQRSTUVW&
            &XYZabcdefghijklmnopqrstuvwxyz0123456789_ "
        integer:: basename, period, i
    continue
        ! ディレクトリ成分らしきものは除去
        basename = scan(src, pathdelim, back=.true.)
        if (basename > 0) then
            result = src(basename + 1: )
        else
            result = src
        endif
        ! 最後の '.' 以降を除去
        period = index(result, '.', back=.true.)
        if (period /= 0) result(period: ) = ""
        ! 変な文字を下線に置換
        do
            i = verify(result, ANS)
            if (i == 0) exit
            result(i:i) = '_'
        enddo
        ! 拡張子を強要
        result = trim(result) // suffix
    end function

end program
