gtvarslicenext.f90

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

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

Methods

Included Modules

gtdata_types dc_error gt_map dc_trace

Public Instance methods

var :type(GT_VARIABLE), intent(in out)
dimord :integer, intent(in), optional
err :logical, intent(out), optional
stat :integer, intent(out), optional

[Source]

subroutine GTVarSliceNext(var, dimord, err, stat)

    implicit none
    type(GT_VARIABLE), intent(in out):: var
    integer, intent(in), optional:: dimord
    logical, intent(out), optional:: err
    integer, intent(out), optional:: stat
    type(gt_dimmap), allocatable:: map(:)
    integer:: mystat, vid, id, nd, idim_lo, idim_hi, ilast

    call beginsub('gtvarslicenext')
    if (present(dimord)) call DbgMessage('dimord=%d', i=(/dimord/))

    call map_lookup(var, vid=vid, ndims=nd)
    if (vid < 0) then
        mystat = nf_enotvar
        goto 999
    endif
    if (nd <= 0) then
        call DbgMessage('dimension map not associated')
        mystat = gt_enomoredims
        goto 999
    endif
    allocate(map(nd))
    call map_lookup(var, map=map)

    if (present(dimord)) then
        if (dimord < 0 .or. dimord <= size(map)) then
            call DbgMessage('dimord=%d is out of 1..%d', i=(/dimord, size(map)/))
            mystat = nf_einval
            goto 995
        endif
        idim_lo = dimord
        idim_hi = dimord
    else
        idim_lo = 1
        idim_hi = size(map)
    endif
    call DbgMessage('idim scan range=(%d:%d)', i=(/idim_lo, idim_hi/))

    mystat = gt_enomoredims
    do, id = idim_lo, idim_hi
        ilast = map(id)%start + (map(id)%count * 2 - 1) * map(id)%stride
        call DbgMessage('last_index=%d allcount=%d',  i=(/ilast, map(id)%allcount/))
        if (ilast >= 1 .and. ilast <= map(id)%allcount) then
            map(id)%start = map(id)%start + map(id)%count * map(id)%stride
            mystat = dc_noerr
            exit
        endif
    enddo
    if (mystat /= dc_noerr) goto 995
    call map_set(var, map, mystat)

995 continue
    deallocate(map)

999 continue
    if (present(stat)) then
        stat = mystat
        if (present(err)) err = (mystat /= DC_NOERR)
    else
        call StoreError(mystat, "GTVarSliceNext", err)
    endif
    call endsub('gtvarslicenext', 'stat=%d', i=(/mystat/))
end subroutine

[Validate]