gtvarexchdim.f90

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

Copyright (C) GFD Dennou Club, 2002. All rights reservied.

Methods

gtvarexchdim  

Included Modules

gtdata_types gt_map dc_trace

Public Instance methods

gtvarexchdim(var, dimord1, dimord2, count_compact, err)
var :type(gt_variable), intent(in)
dimord1 :integer, intent(in)
dimord2 :integer, intent(in)
count_compact :logical, intent(in), optional
err :logical, intent(out)

次元対応表の順位の交換

[Source]

subroutine gtvarexchdim(var, dimord1, dimord2, count_compact, err)

    implicit none
    type(gt_variable), intent(in):: var
    integer, intent(in):: dimord1, dimord2
    logical, intent(in), optional:: count_compact
    logical, intent(out):: err
    type(gt_dimmap), allocatable:: map(:)
    type(gt_dimmap):: tmpmap
    integer:: ndimsp, stat, idim1, idim2
    logical:: direct_mode
    character(*), parameter:: subname = 'gtvarexchdim'
continue
    err = .true.
    direct_mode = .false.
    if (present(count_compact)) then
        direct_mode = count_compact
    endif
    call beginsub(subname)
    if (dimord1 < 1 .or. dimord2 < 1) then
        call endsub(subname, "negative dimord=%d %d invalid", i=(/dimord1, dimord2/))
        return
    endif
    call map_lookup(var, ndims=ndimsp)
    if (ndimsp <= 0) then
        call endsub(subname, "variable invalid")
        return
    else if (dimord1 > ndimsp .or. dimord2 > ndimsp) then
        call endsub(subname, "dimord=%d %d not exist", i=(/dimord1, dimord2/))
        return
    endif

    allocate(map(ndimsp))
    call map_lookup(var, map=map)

    if (.not. direct_mode) then
        idim1 = dimord_skip_compact(dimord1, map)
        idim2 = dimord_skip_compact(dimord2, map)
        if (idim1 < 0 .or. idim2 < 0) then
            call endsub(subname, "dimord=%d %d not found after compaction",  i=(/dimord1, dimord2/))
            deallocate(map)
            return
        endif
    else
        idim1 = dimord1
        idim2 = dimord2
    endif

    tmpmap = map(idim1)
    map(idim1) = map(idim2)
    map(idim2) = tmpmap
    call map_set(var, map, stat)
    deallocate(map)

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

[Validate]