! Copyright (C) GFD Dennou Club, 2001. All rights reserved. subroutine gtvardeldim(var, dimord, err) use gtdata_types, only: gt_variable use gt_map, only: map_lookup, gt_dimmap, map_set_ndims, map_set use dc_trace, only: beginsub, endsub, DbgMessage implicit none type(gt_variable), intent(in):: var integer, intent(in):: dimord logical, intent(out):: err type(gt_dimmap), allocatable:: map(:) type(gt_dimmap):: tmpmap integer:: ndimsp, stat character(*), parameter:: subname = 'gtvardeldim' continue err = .true. call beginsub(subname) if (dimord < 1) then call endsub(subname, "negative dimord=%d invalid", i=(/dimord/)) return endif call map_lookup(var, ndims=ndimsp) if (ndimsp <= 0) then call endsub(subname, "variable invalid") return else if (dimord > ndimsp) then call endsub(subname, "dimord=%d not exist", i=(/dimord/)) return endif allocate(map(ndimsp)) call map_lookup(var, map=map) tmpmap = map(dimord) map(dimord: ndimsp-1) = map(dimord+1: ndimsp) map(ndimsp) = tmpmap call map_set(var, map, stat) deallocate(map) call map_set_ndims(var, ndims = ndimsp - 1, stat=stat) err = stat /= 0 call endsub(subname) end subroutine