! Copyright (C) GFD Dennou Club, 2002.  All rights reserved
! gtvectdefault.f90 - Definitions of Gtool vectors subroutines

subroutine GTVectOpen(result, var1, var2)
    use gtgraph_types, only: GT_VECTORS
    use gtgraph_generic, only: GOpen => Open
    use gtdata_types, only: GT_VARIABLE
    use gtdata_generic, only: Open
    use dc_trace, only: beginsub, endsub
    implicit none
    type(GT_VECTORS), intent(out):: result
    type(GT_VARIABLE), intent(in):: var1
    type(GT_VARIABLE), intent(in):: var2
continue
    call beginsub('gtvectopen')
    call Open(result%var1, var1, 0)
    call Open(result%var2, var2, 0)
    result%animate = .FALSE.
    allocate(result%h_axis, result%v_axis)
    call GOpen(result%h_axis, var1, 1)
    call GOpen(result%v_axis, var1, 2)
    ! オプションの初期化
    result%map = ""
    result%hskip = 0
    result%vskip = 0
    call endsub('gtvectopen')
end subroutine

subroutine GtvectClose(vect)
    use gtgraph_types, only: GT_VECTORS
    use gtgraph_generic, only: GClose => Close
    use gtdata_generic, only: Close
    use dc_trace, only: beginsub, endsub
    implicit none
    type(GT_VECTORS), intent(inout):: vect
    call beginsub('gtvectclose')
    call GClose(vect%h_axis)
    call GClose(vect%v_axis)
    deallocate(vect%h_axis, vect%v_axis)
    call Close(vect%var1)
    call Close(vect%var2)
    call endsub('gtvectclose')
end subroutine

subroutine GtvectOption(vect, optname, value, err)
    use gtgraph_types, only: GT_VECTORS
    use gtdata_generic, only: slice_next
    use dc_string, only: stoi, stod, toUpper, get_array
    use dc_error, only: GT_ENOMOREDIMS, DC_NOERR
    use dc_trace, only: beginsub, endsub, message
    implicit none
    type(GT_VECTORS), intent(inout):: vect
    character(len = *), intent(in):: optname
    character(len = *), intent(in):: value
    logical, intent(out):: err
    character(len = len(optname)):: uc_name
    integer:: stat
continue
    err = .FALSE.
    uc_name = optname
    call toUpper(uc_name)
    call beginsub('gtvectoption', '%c=%c', c1=trim(uc_name), c2=trim(value))
    select case(uc_name)
    case("-ANIMATE")
        call message('vect animation enabled')
        vect%animate = .TRUE.
    case("-NEXT")
        if (vect%animate) then
            call slice_next(vect%var1, stat=stat)
            call slice_next(vect%var2, stat=stat)
            err = (stat /= DC_NOERR)
            call message('vect next okay=%y stat=%d', L=(/.not. err/), i=(/stat/))
        else
            err = .TRUE.
        endif
    case("-MAP")
        vect%map = "coast_world"
    case("MAP")
        vect%map = value 
    case("HSKIP", "HS")
	vect%hskip = stoi(value)
    case("VSKIP", "VS")
	vect%vskip = stoi(value)
    case("SKIP", "SK")
	vect%hskip = stoi(value)
	vect%vskip = vect%hskip
    case("-EXCH")
        call option_exch(vect, err)
    case default
        err = .TRUE.
    end select
    call endsub('gtvectoption')
    return

contains

    subroutine option_exch(vect, err)
        use gtgraph_types, only: GT_VECTORS, GT_AXIS
        use gtdata_generic, only: exch_dim
        use dc_trace, only: beginsub, endsub, message
    implicit none
        type(GT_VECTORS), intent(inout):: vect
        character(len = *), parameter:: subname &
            & = "GTVectOption%%Option_Exch"
        type(GT_AXIS), pointer:: tmp_axis
        logical, intent(out):: err
    continue
        call beginsub(subname)
        tmp_axis => vect%h_axis
        vect%h_axis => vect%v_axis
        vect%v_axis => tmp_axis
        call exch_dim(vect%var1, 1, 2, count_compact=.false., err=err)
	if (.not. err) then
	call exch_dim(vect%var2, 1, 2, count_compact=.false., err=err)
	endif
        call endsub(subname)
    end subroutine

end subroutine

subroutine GTFigBindVect(fig, vect)
    use gtgraph_types, only: GT_FIGURE, GT_VECTORS
    use gtgraph_generic, only: Close
    use gtdata_generic, only: get_attr, inquire
    use dc_string, only: STRING
    use dc_error
    use netcdf_f77, only: NF_ENOMEM
    use dc_trace, only: beginsub, endsub, message
    implicit none
    type(GT_FIGURE), intent(inout):: fig
    type(GT_VECTORS), intent(inout):: vect
    type(GT_VECTORS), pointer:: newvects(:)
    character(STRING):: title, units
    integer:: nvects, stat
    !
    call beginsub('gtfigbindvect')
    ! stat = GT_EFAKE
    if (associated(fig%h_axis)) then
	call message('resource for fig%h_axis may leak')
	vect%h_axis => fig%h_axis
    else
	fig%h_axis => vect%h_axis
    endif
    if (associated(fig%v_axis)) then
	call message('resource for fig%v_axis may leak')
	vect%v_axis => fig%v_axis
    else
        fig%v_axis => vect%v_axis
    endif
    !
    call get_attr(vect%var1, 'long_name', title)
    if (title == '') call Inquire(vect%var1, name=title)
    call get_attr(vect%var1, 'units', units, default='no units')
    title = trim(title) // ' [' // trim(units) // ']'
    if (fig%title == "untitled") then
        fig%title = title
    else
        fig%title = trim(fig%title) // ", " // trim(title)
    endif
    if (fig%aspect == 0.0) then
        call get_attr(vect%var1, 'gt_graph_aspect_ratio', fig%aspect, &
            default=fig%aspect)
    endif
    if (vect%animate) fig%animate = .TRUE.
    !
    stat = 0
    if (associated(fig%vectors)) then
        nvects = size(fig%vectors)
        allocate(newvects(nvects + 1), stat=stat)
        newvects(1: nvects) = fig%vectors(1: nvects)
        deallocate(fig%vectors)
    else
        nvects = 0
        allocate(newvects(1), stat=stat)
    endif
    if (stat /= 0) stat = NF_ENOMEM
    newvects(nvects + 1) = vect
    fig%vectors => newvects
999 continue
    call StoreError(stat, 'GTFigPutVect')
    call endsub('gtfigbindvect', 'stat=%d', i=(/stat/))
end subroutine

subroutine GTVectDraw(vect, parent)
    use gtgraph_generic, only: Draw
    use gtgraph_types, only: GT_VECTORS, GT_FIGURE
    use gtdata_generic, only: Get
    use dcl
    use dc_trace, only: beginsub, endsub
    implicit none
    type(GT_VECTORS), intent(inout):: vect
    type(GT_FIGURE), intent(in):: parent
    real, pointer:: buffer1(:, :)
    real, pointer:: buffer2(:, :)
    real, pointer:: axvalue(:)
    integer:: xs, ys, nx, ny
continue
    call beginsub('gtvectdraw')
    ! 空間を設定するため座標軸を描画
    call Draw(vect%h_axis, vect%v_axis, parent, set_space=.FALSE.)
    ! データの取得と描画
    call Get(vect%var1, buffer1)
    call Get(vect%var2, buffer2)
    ! スキップ
    xs = vect%hskip
    ys = vect%vskip
    nx = size(buffer1, 1)
    ny = size(buffer1, 2)
    if (xs == 0) xs = nx / 20
    if (ys == 0) ys = ny / 20
    xs = max(nx / 40, min(nx / 3, xs))
    ys = max(ny / 40, min(ny / 3, ys))
    !
    !
    call get(vect%h_axis%var, axvalue)
    call DclSetXGrid(axvalue(1:nx:xs))
    deallocate(axvalue)
    call get(vect%v_axis%var, axvalue)
    call DclSetYGrid(axvalue(1:ny:ys))
    deallocate(axvalue)
    ! 描画
    call DclDrawVectors(buffer1(1:nx:xs, 1:ny:ys), buffer2(1:nx:xs, 1:ny:ys))
    deallocate(buffer1)
    deallocate(buffer2)
    if (vect%map /= "") then
        call DclDrawMap(vect%map)
        if (vect%h_axis%upper > 180.0) then
            call DclSetWindow(vect%h_axis%lower - 360.0, &
                & vect%h_axis%upper - 360.0, &
                & vect%v_axis%lower, vect%v_axis%upper)
            call DclSetTransFunction()
            call DclDrawMap(vect%map)
            call DclSetWindow(vect%h_axis%lower, vect%h_axis%upper, &
                & vect%v_axis%lower, vect%v_axis%upper)
            call DclSetTransFunction()
        endif
    endif
    call GTAxesDrawGrid(vect%h_axis, vect%v_axis, parent)
999 continue
    call endsub('gtvectdraw')
end subroutine

subroutine GTVectLoad(vect, var)
    use gtgraph_types, only: GT_VECTORS
    use gtdata_types, only: GT_VARIABLE
    use gtgraph_generic, only: Load
    use gtdata_generic  ! いっぱい使うから書くのはやめ
    use dc_types, only: STRING
    use dc_error
    implicit none
    type(GT_VECTORS), intent(out):: vect
    type(GT_VARIABLE), intent(in):: var
    character(STRING):: varname
    ! リンク名が data であることを仮定
    call get_attr(var, "gt_structure_link_data", varname)
    if (varname == "") then
        call StoreError(GT_EBADLINK, "GTVectLoad(data1 variable)")
        return
    endif
    call Open(vect%var1, varname)
    call get_attr(var, "gt_structure_link_data2", varname)
    if (varname == "") then
        call StoreError(GT_EBADLINK, "GTVectLoad(data2 variable)")
        return
    endif
    call Open(vect%var2, varname)
    allocate(vect%h_axis, vect%v_axis)
    call get_attr(var, "gt_structure_link_haxis", varname)
    call Load(vect%h_axis, varname)
    call get_attr(var, "gt_structure_link_vaxis", varname)
    call Load(vect%v_axis, varname)
    ! オプションの初期化
    call get_attr(var, "gt_graph_draw_map", vect%map, default="")
    call get_attr(var, "gt_graph_vectors_hskip", vect%hskip, default=0)
    call get_attr(var, "gt_graph_vectors_vskip", vect%vskip, default=0)
end subroutine

! GTVectSave - 図を変数として保存

subroutine GTVectSave(vect, name, name_result)
    use gtgraph_generic, only: Save, GTGraphSaveName
    use gtgraph_types, only: GT_VECTORS
    use gtdata_types, only: GT_VARIABLE
    use gtdata_generic, only: Create, Close, Put_Attr, get_attr, add_member, &
        & Inquire
    use dc_string
    use dc_types, only: STRING
    implicit none
    type(GT_VECTORS), intent(inout):: vect
    type(VSTRING), intent(in), optional:: name
    type(VSTRING), intent(out), optional:: name_result
    type(VSTRING):: member
    character(STRING):: member_c, url, vname, title, title2
    type(GT_VARIABLE):: var
    character(len = *), parameter:: GTCT = "gt_graph_vectors_"
continue
    if (present(name)) then
        vname = name
    else
        call GTGraphSaveName(result=vname)
    endif
    call get_attr(vect%var1, "long_name", title)
    call get_attr(vect%var2, "long_name", title2)
    title = "vectors of " // trim(title) // " + " // trim(title2)
    call Create(var, trim(vname), xtype="int", overwrite=.TRUE., &
        long_name=trim(title))
    call Put_Attr(var, "gt_structure_class", "vectors")
    call Put_Attr(var, "gt_graph_vectors_hskip", (/vect%hskip/))
    call Put_Attr(var, "gt_graph_vectors_vskip", (/vect%vskip/))
    if (vect%map /= "") then
        call Put_Attr(var, "gt_graph_draw_map", trim(vect%map))
    endif

    ! 図のメンバになっているものたちの書き出し
    call Inquire(vect%var1, url=url)
    call add_member(var, url, link_name="data")
    call Inquire(vect%var2, url=url)
    call add_member(var, url, link_name="data2")
    if (associated(vect%v_axis)) then
        if (vect%v_axis%saved /= "") then
            call add_member(var, vect%v_axis%saved, link_name="vaxis")
        else
            call Save(vect%v_axis, resultname=member)
            member_c = member
            call add_member(var, member_c, link_name="vaxis")
        endif
    endif
    if (associated(vect%h_axis)) then
        if (vect%h_axis%saved /= "") then
            call add_member(var, vect%h_axis%saved, link_name="haxis")
        else
            call Save(vect%h_axis, resultname=member)
            member_c = member
            call add_member(var, member_c, link_name="haxis")
        endif
    endif
    
    call Close(var)
    print *, trim(title), " stored at ", trim(vname), "."
    if (present(name_result)) name_result = vname
end subroutine
