! Copyright (C) GFD Dennou Club, 2000. All rights reserved. subroutine GTVarGetReal3(var, value, err) use gtdata_types, only: gt_variable use gtdata_generic, only: get_slice, gtvargetreal, inquire use gt_map, only: map_set_rank use dc_error, only: storeerror, dc_noerr use dc_trace, only: beginsub, endsub, DbgMessage implicit none type(gt_variable), intent(inout) :: var real, pointer :: value(:, :, :) logical, intent(out), optional :: err integer :: stat, n(3) continue call beginsub('gtvargetreal3', 'var.mapid=%d', i=(/var%mapid/)) call map_set_rank(var, 3, stat) if (stat /= dc_noerr) goto 999 call get_slice(var, dimord=1, count=n(1), count_compact=.false.) call get_slice(var, dimord=2, count=n(2), count_compact=.false.) call get_slice(var, dimord=3, count=n(3), count_compact=.false.) ! value を allocate (重複 allocate しないようにチェック) if ( associated(value) ) then if ( .not. size(value,1) == n(1) .or. & & .not. size(value,2) == n(2) .or. & & .not. size(value,3) == n(3) ) then call DbgMessage('@ nullify value(%d,%d,%d), & & allocate value(%d,%d,%d)', & & i=(/size(value,1), size(value,2), size(value,3), & & n(1), n(2), n(3)/) ) nullify(value) allocate(value(n(1), n(2), n(3))) else call DbgMessage('@ value(%d,%d,%d) is already allocated', & & i=(/n(1), n(2), n(3)/)) endif else call DbgMessage('@ allocate value(%d,%d,%d)', i=(/n(1),n(2),n(3)/)) allocate(value(n(1), n(2), n(3))) endif call gtvargetreal(var, value, product(n), err) call DbgMessage('max=%r min=%r', r=(/maxval(value), minval(value)/)) 999 continue call endsub('gtvargetreal3', 'n=%d', i=(/n/)) call storeerror(stat, 'gtvargetreal3') end subroutine