gtvaradddim.f90

Path: src/gtvaradddim.f90
Last Update: Wed Jul 20 18:22:24 JST 2005

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

Methods

gtvaradddim  

Included Modules

gtdata_types gtdata_generic gt_map dc_trace

Public Instance methods

gtvaradddim(var, dimord, dimvar, err)
var :type(GT_VARIABLE), intent(in)
dimord :integer, intent(in)
dimvar :type(GT_VARIABLE), intent(in)
err :logical, intent(out)

もし dimord が var の有効次元数より大きければ (有効次元数 + 1) が与えられたものとみなされる。

[Source]


subroutine gtvaradddim(var, dimord, dimvar, err)

    implicit none
    type(GT_VARIABLE), intent(in):: var
    type(GT_VARIABLE), intent(in):: dimvar
    integer, intent(in):: dimord
    logical, intent(out):: err
    type(gt_dimmap), pointer:: map(:)
    type(gt_dimmap):: tmpmap
    integer:: id, nd, ndimsp, stat, vid
    character(*), parameter:: subname = 'gtvaradddim'
continue
    err = .true.
    call beginsub(subname)

    if (dimord < 1) then
        call endsub(subname, "negative dimord=%d invalid", i=(/dimord/))
        return
    endif

    ! dimvar をチェックしマップ設定を tmpmap に保存
    call map_lookup(dimvar, vid=vid, ndims=nd)
    if (vid < 0) then
        call endsub(subname, "dimvar invalid")
        return
    endif
    if (nd <= 0) then
        call endsub(subname, "dimvar nondimensional")
        return
    else if (nd > 1) then
        call endsub(subname, "dimvar multidimensional")
        return
    endif
    allocate(map(nd))
    call map_lookup(dimvar, map=map)
    tmpmap = map(1)
    deallocate(map)

    ! dimord 番目 (ただし ndimsp + 1 を越えない) に挿入する隙間をあける
    call map_lookup(var, ndims=ndimsp)
    if (dimord > ndimsp + 1) then
        id = ndimsp + 1
    else
        id = dimord
    endif
    allocate(map(nd + 1))
    call map_resize(var, nd + 1)
    call map_lookup(var, map=map)
    map(id+1: nd+1) = map(id: nd)

    ! 新しい次元への参照を挿入
    map(id)%dimno = -1
    call inquire(dimvar, url=map(id)%url)
    map(id)%allcount = tmpmap%allcount
    map(id)%offset = tmpmap%offset
    map(id)%step = tmpmap%step
    map(id)%start = tmpmap%start
    map(id)%count = tmpmap%count
    map(id)%stride = tmpmap%stride

    ! 登録
    call map_set(var, map=map, stat=stat)
    if (stat /= 0) goto 999
    call map_set_ndims(var, ndims=ndimsp + 1, stat=stat)

999 continue
    err = (stat /= 0)
    call endsub(subname)
end subroutine

[Validate]