! Copyright (C) GFD Dennou Club, 2000.  All rights reserved

module gt_map

    ! GTOOL 変数表
    !
    ! gtool 変数というのは実はマップ表のキーとなる整数ハンドルである。
    ! マップ表 maptab には実体表のエントリ番号と次元書き換え／イテレータ
    ! の表が載っている。
    ! このレベルにおける参照カウントは作らないことにする。つまり、
    ! マップ表と実体表は一対一対応するし、
    ! ユーザがハンドルをコピーするのは勝手である。
    ! もちろんユーザには必ずただ１回
    ! 当該ハンドルを close すなわち maptabdelete する義務がある。

    use dc_types, only: string
    use gt_vartable

    implicit none

    ! 次元書き換え表
    type GT_DIMMAP
        ! 正ならば実体変数の次元番号, 他変数参照時は非正値
        integer:: dimno
        ! 次元変数の url
        character(len=string):: url
        ! --- 実体と gtool ユーザの格子番号対応 ---
        !    ユーザからみて 1..allcount が実体の
        !    (1..allcount) * step + offset に写像される。
        !    これらの値の変更の際は実体変数の許容添字範囲および
        !    成長可能性を確認する必要あり。
        ! start 値に対するオフセット
        integer:: offset
        ! 1 か -1 の値をとることが期待される。
        integer:: step
        ! 見掛けの格子番号上限: start + count * stride <= allcount
        integer:: allcount
        ! ---- イテレータ本体 ---
        ! 入出力範囲は (start:start+count*stride:stride) である。
        ! イテレータ start 値
        integer:: start
        ! イテレータ count 値
        integer:: count
        ! イテレータ stride 値
        integer:: stride
    end type

    ! マップ表の型
    type MAP_TABLE_ENTRY
        integer:: vid
        integer:: ndims
        type(GT_DIMMAP), pointer:: map(:)
    end type

    type(MAP_TABLE_ENTRY), save, target, allocatable:: maptab(:)
    integer, parameter:: maptab_init_size = 16

    public:: MapTabAdd, MapTabDelete, map_lookup
    public:: var_class, map_create, map_to_internal_specs, dimrange
    private:: maptab, maptab_init_size

    interface dimrange
        module procedure dimrange_by_dimno
    end interface

contains

    ! 変数と次元番号を指定して、当該次元の内部的添字番号範囲を得る
    subroutine dimrange_by_dimno(var, dimno, dimlo, dimhi)
        use gtdata_types, only: gt_variable
        use gtdata_generic, only: open, close
        use gtdata_internal, only: dimrange
        type(gt_variable), intent(in):: var
        integer, intent(in):: dimno
        integer, intent(out):: dimlo, dimhi
        type(gt_variable):: dimvar
        integer:: vid
        call open(dimvar, var, dimno, count_compact=.true.)
        call map_lookup(dimvar, vid=vid)
        call dimrange(vid, dimlo, dimhi)
        call close(dimvar)
    end subroutine

    ! 変数 source_var の複写 var を作成する
    subroutine map_dup(var, source_var)
        use gtdata_types, only: gt_variable
        use gt_vartable, only: VarTableAdd, VarTableLookup
        use dc_trace, only: message
        type(gt_variable), intent(out):: var
        type(gt_variable), intent(in):: source_var
        integer:: vid, mid1, mid2, vid2, nd, class, cid
        call map_lookup(source_var, vid=vid)
        if (vid < 0) then
            var = gt_variable(-1)
            return
        endif
        if (vid == 0) then
            vid2 = 0
        else
            call VartableLookup(vid, class=class, cid=cid)
            call VarTableAdd(vid2, class, cid)
        endif
        call MapTabAdd(var%mapid, vid2)
        mid1 = source_var%mapid
        mid2 = var%mapid
        maptab(mid2)%ndims = maptab(mid1)%ndims
        if (associated(maptab(mid1)%map)) then
            nd = size(maptab(mid1)%map)
            allocate(maptab(mid2)%map(nd))
            maptab(mid2)%map(1:nd) = maptab(mid1)%map(1:nd)
        else
            nullify(maptab(mid2)%map)
        endif
        call message('map_dup mapid(%d from %d) vid(%d from %d)', &
            & i=(/mid2, mid1, maptab(mid2)%vid, maptab(mid1)%vid/))
    end subroutine

    ! 変数 var を作成する。内部種別 class, 内部識別子 cid,
    ! 外見的次元数 ndims, 外見的次元長 allcount(:) を与える。
    ! オフセットゼロを仮定して諸元の初期化が行われる。
    subroutine map_create(var, class, cid, ndims, allcount)
        use gtdata_types, only: gt_variable
        use gt_vartable, only: VarTableAdd
        type(gt_variable), intent(out):: var
        integer, intent(in):: class, cid, ndims, allcount(:)
        type(gt_dimmap), pointer:: map(:)
        integer:: vid, i
        call VarTableAdd(vid, class, cid)
        call MapTabAdd(var%mapid, vid)
        call map_allocate(map, ndims)
        maptab(var%mapid)%ndims = ndims
        maptab(var%mapid)%map => map
        do, i = 1, ndims
            map(i)%dimno = i
            map(i)%allcount = allcount(i)
            map(i)%count = allcount(i)
            map(i)%offset = 0
            map(i)%start = 1
            map(i)%step = 1
            map(i)%stride = 1
        enddo
    end subroutine

    ! すでに実体表に追加されたエントリ番号 vid を指定して、
    ! マップ表にエントリを追加する。
    subroutine MapTabAdd(mapid, vid)
        integer, intent(out):: mapid
        integer, intent(in):: vid
        type(MAP_TABLE_ENTRY), allocatable:: tmp_maptab(:)
        integer:: i, n
        ! 必要なら初期確保
        if (.not. allocated(maptab)) then
            allocate(maptab(maptab_init_size))
            maptab(:)%vid = vid_invalid
            do, n = 1, maptab_init_size
                nullify(maptab(n)%map)
            enddo
        endif
        ! 空き地があればそこに割り当て
        do, i = 1, size(maptab)
            if (maptab(i)%vid == vid_invalid) then
                mapid = i
                maptab(mapid)%vid = vid
                return
            endif
        enddo
        ! 空き地はなかったのだから倍幅確保
        n = size(maptab)
        allocate(tmp_maptab(n))
        tmp_maptab(:) = maptab(:)
        deallocate(maptab)
        allocate(maptab(n * 2))
        ! 確保したところはクリア
        maptab(1:n) = tmp_maptab(1:n)
        do, i = n + 1, (2 * size(tmp_maptab))
            maptab(i)%vid = vid_invalid
            nullify(maptab(i)%map)
        enddo
        deallocate(tmp_maptab)
        mapid = n + 1
        maptab(mapid)%vid = vid
    end subroutine

    ! 変数 var をマップ表から削除する。
    ! 実体表には手をつけない。
    subroutine MapTabDelete(var, err)
        use dc_error, only: nf_enotvar, storeerror, dc_noerr
        use gtdata_types, only: gt_variable
        use dc_trace, only: message
        implicit none
        type(gt_variable), intent(in):: var
        logical, intent(out), optional:: err
        integer:: mapid
        mapid = var%mapid
        if (.not. allocated(maptab)) goto 999
        if (mapid <= 0 .or. mapid > size(maptab)) goto 999
        if (maptab(mapid)%vid == vid_invalid) goto 999
        maptab(mapid)%vid = vid_invalid
        if (associated(maptab(mapid)%map)) deallocate(maptab(mapid)%map)
        call storeerror(dc_noerr, 'maptabdelete', err)
        call message('gt_map table %d deleted', i=(/mapid/))
        return
    999 continue
        call storeerror(nf_enotvar, 'maptabdelete', err)
    end subroutine

    ! 同じファイル番号の変数表の中身を返す
    subroutine map_lookup(var, vid, map, ndims)
        use gtdata_types, only: gt_variable
        type(gt_variable), intent(in):: var
        integer, intent(out), optional:: vid
        type(gt_dimmap), intent(out), optional:: map(:)
        integer, intent(out), optional:: ndims
        if (.not. allocated(maptab)) goto 999
        if (var%mapid <= 0 .or. var%mapid > size(maptab)) goto 999
        if (maptab(var%mapid)%vid == vid_invalid) goto 999
        if (present(vid)) vid = maptab(var%mapid)%vid
        if (present(map)) map(:) = maptab(var%mapid)%map(1:size(map))
        if (present(ndims)) ndims = maptab(var%mapid)%ndims
        return
    999 continue
        if (present(vid)) vid = vid_invalid
        if (present(map)) then
            map(:)%dimno = -1
            map(:)%url = " "
        endif
        if (present(ndims)) ndims = 0
    end subroutine

    ! 同じファイル番号の変数表の値を設定する
    subroutine map_set(var, map, stat)
        use gtdata_types, only: gt_variable
        use dc_error, only: nf_enotvar, gt_enomoredims, dc_noerr
        type(gt_variable), intent(in):: var
        type(gt_dimmap), intent(in):: map(:)
        integer, intent(out):: stat
        if (.not. allocated(maptab)) goto 999
        if (var%mapid <= 0 .or. var%mapid > size(maptab)) goto 999
        if (maptab(var%mapid)%vid == vid_invalid) goto 999
        if (size(map) > size(maptab(var%mapid)%map)) then
            stat = gt_enomoredims
            return
        endif
        maptab(var%mapid)%map(1:size(map)) = map(:)
        stat = dc_noerr
        return
    999 continue
        stat = nf_enotvar
    end subroutine


    ! 変数 var を指定して、内部種別 class, 内部識別子 cid を得る。
    subroutine var_class(var, class, cid)
        use gtdata_types, only: gt_variable
        use gt_vartable, only: vartablelookup
        type(gt_variable), intent(in):: var
        integer, intent(out), optional:: class, cid
        integer:: vid
        call map_lookup(var, vid=vid)
        call vartablelookup(vid, class=class, cid=cid)
    end subroutine

    ! 変数 var の次元数を ndims に変える。
    subroutine map_set_ndims(var, ndims, stat)
        use gtdata_types, only: gt_variable
        use gt_vartable, only: vartablelookup
        use dc_error, only: nf_enotvar, gt_enomoredims, dc_noerr
        type(gt_variable), intent(in):: var
        integer, intent(in):: ndims
        integer, intent(out):: stat
        integer:: vid
        call map_lookup(var, vid=vid)
        if (vid == vid_invalid) then
            stat = nf_enotvar
            return
        endif
        if (.not. associated(maptab(var%mapid)%map)) then
            if (ndims == 0) then
                stat = dc_noerr
                maptab(var%mapid)%ndims = 0
            else
                stat = gt_enomoredims
            endif
        else
            if (ndims > size(maptab(var%mapid)%map)) then
                stat = gt_enomoredims
            else
                stat = dc_noerr
                maptab(var%mapid)%ndims = ndims
            endif
        endif
    end subroutine

    ! 変数 var のランク(非縮退次元数)を rank に減らすように
    ! count 値を1に減らす。ランクを増やすことや外見次元数の操作はしない。
    subroutine map_set_rank(var, rank, stat)
        use gtdata_types, only: gt_variable
        use gt_vartable, only: vartablelookup
        use dc_error, only: nf_enotvar, gt_enomoredims, dc_noerr
        type(gt_variable), intent(in):: var
        integer, intent(in):: rank
        integer, intent(out):: stat
        type(gt_dimmap), pointer:: tmpmap(:)
        integer:: ndims
        integer:: vid, nd
        call map_lookup(var, vid, ndims=ndims)
        if (vid == vid_invalid) then
            stat = nf_enotvar
            return
        endif
        if (ndims < rank) then
            stat = gt_enomoredims
            return
        endif
        tmpmap => maptab(var%mapid)%map
        do, nd = ndims, 1, -1
            if (count(tmpmap(1:ndims)%count > 1) <= rank) exit
            tmpmap(nd)%count = 1
        enddo
        stat = dc_noerr
    end subroutine

    ! マップ表から netCDF の引数にふさわしい start, count, stride, imap
    ! を作成する。ただし、stride が負になるばあいは対策されていない。
    ! (暫定的に anvarget/anvarput が対応している)
    subroutine map_to_internal_specs(var, specs, ndims)
        use gtdata_types, only: gt_variable
        use gtdata_internal, only: num_dimensions => ndims
        type(gt_variable), intent(in):: var
        integer, pointer:: specs(:, :)
        integer, intent(out), optional:: ndims
        type(gt_dimmap), pointer:: it
        integer:: vid, i, j, imap, internal_ndims
        integer:: external_ndims 
    continue
        call map_lookup(var, vid, ndims=external_ndims)
        internal_ndims = num_dimensions(vid)
        if (present(ndims)) ndims = internal_ndims
        allocate(specs(max(1, internal_ndims), 4))
        specs(:, 1) = 1
        specs(:, 2) = 1
        specs(:, 3) = 1
        specs(:, 4) = 0
        imap = 1
        do, i = 1, size(maptab(var%mapid)%map)
            it => maptab(var%mapid)%map(i)
            j = it%dimno
            if (j > 0 .and. j <= internal_ndims) then
                specs(j, 1) = it%start + it%offset
                specs(j, 2) = it%count
                if (i > external_ndims) specs(j, 2) = 1
                specs(j, 3) = it%stride * it%step
                specs(j, 4) = imap
            endif
            imap = imap * it%count
        enddo
    end subroutine

    ! 次元表エントリに ndims 個のエントリを割り付け初期化する。
    subroutine map_allocate(map, ndims)
        type(GT_DIMMAP), pointer:: map(:)
        integer, intent(in):: ndims
        if (ndims <= 0) then
            nullify(map)
            return
        endif
        allocate(map(1:ndims))
        map(1:ndims)%dimno = -1
        map(1:ndims)%url = ' '
        map(1:ndims)%allcount = 0
        map(1:ndims)%offset = 0
        map(1:ndims)%step = 1
        map(1:ndims)%start = 1
        map(1:ndims)%count = 0
        map(1:ndims)%stride = 1
    end subroutine

    ! 変数 var にマップ表 map を組み合わせる
    subroutine map_apply(var, map)
        use gtdata_types, only: gt_variable
        type(GT_VARIABLE), intent(inout):: var
        type(GT_DIMMAP), pointer:: map(:)
        type(GT_DIMMAP), pointer:: tmpmap(:), varmap
        integer:: i, nd
        nd = size(map)
        allocate(tmpmap(nd))
        do, i = 1, nd
            tmpmap(i)%allcount = map(i)%allcount
            tmpmap(i)%count = map(i)%count
            if (map(i)%dimno > 0) then
                varmap => maptab(var%mapid)%map(map(i)%dimno)
                tmpmap(i)%url = varmap%url
                tmpmap(i)%dimno = varmap%dimno
                tmpmap(i)%offset = varmap%offset + map(i)%offset
                tmpmap(i)%step = varmap%step * map(i)%step
            else
                tmpmap(i)%url = map(i)%url
                tmpmap(i)%dimno = 0
                tmpmap(i)%offset = map(i)%offset
                tmpmap(i)%step = map(i)%step
            endif
        enddo
        deallocate(map)
        map => tmpmap
    end subroutine

    ! 変数 var の次元表の大きさを変える
    subroutine map_resize(var, ndims)
        use gtdata_types, only: gt_variable
        type(GT_VARIABLE), intent(in):: var
        integer, intent(in):: ndims
        type(GT_DIMMAP), pointer:: newmap(:)
        type(GT_DIMMAP), pointer:: tmpmap(:)
        integer:: n
        if (associated(maptab(var%mapid)%map)) then
            tmpmap => maptab(var%mapid)%map
            call map_allocate(newmap, ndims)
            n = min(size(tmpmap), ndims)
            newmap(1:n) = tmpmap(1:n)
            deallocate(tmpmap)
            maptab(var%mapid)%map => newmap
            newmap(n+1:ndims)%dimno = -1
            newmap(n+1:ndims)%url = ' '
            newmap(n+1:ndims)%allcount = 0
            newmap(n+1:ndims)%offset = 0
            newmap(n+1:ndims)%step = 1
            newmap(n+1:ndims)%start = 1
            newmap(n+1:ndims)%count = 0
            newmap(n+1:ndims)%stride = 1
        else
            call map_allocate(maptab(var%mapid)%map, ndims)
            n = 1
        endif
    end subroutine

    ! 変数のプロパティを出力
    subroutine gtvar_dump(var)
        use gtdata_types, only: gt_variable
        use gt_vartable, only: vartable_dump
        use dc_trace, only: debug, message
        type(gt_variable), intent(in):: var
        integer:: idim, imap
        if (.not. debug()) return
        imap = var%mapid
        if (imap < 1 .or. imap > size(maptab)) then
            call message('[gt_variable %d: invalid id]', i=(/imap/))
            return
        endif
        if (associated(maptab(imap)%map)) then
            call message('[gt_variable %d: ndims=%d, map.size=%d]', &
                & i=(/imap, maptab(imap)%ndims, size(maptab(imap)%map)/))
            do, idim = 1, size(maptab(imap)%map)
                call message('[dim%d dimno=%d ofs=%d step=%d' &
                    &// ' all=%d start=%d count=%d stride=%d url=%c]', &
                    & c1=trim(maptab(imap)%map(idim)%url), &
                    & i=(/idim, maptab(imap)%map(idim)%dimno, &
                    & maptab(imap)%map(idim)%offset, &
                    & maptab(imap)%map(idim)%step, &
                    & maptab(imap)%map(idim)%allcount, &
                    & maptab(imap)%map(idim)%start, &
                    & maptab(imap)%map(idim)%count, &
                    & maptab(imap)%map(idim)%stride/))
            enddo
        else
            call message('[gt_variable %d: ndims=%d, map=null]', &
                & i=(/imap, maptab(imap)%ndims/))
        endif
        call vartable_dump(maptab(imap)%vid)
    end subroutine

    ! 次元表の中で非縮退次元だけを数えた次元番号 dimord の次元を
    ! 特定し、外部向けの次元番号を返す。
    integer function dimord_skip_compact(dimord, map) result(result)
        use dc_trace, only: message
        integer, intent(in):: dimord
        type(gt_dimmap), intent(in):: map(:)
        integer:: nd, id
        result = -1
        nd = 0
        do, id = 1, size(map)
            if (map(id)%count < 2) cycle
            nd = nd + 1
            if (nd < dimord) cycle
            result = id
            call message('compact dim skip: %d <= %d', i=(/result, dimord/))
            exit
        enddo
    end function

end module
