! Copyright (C) GFD Dennou Club, 2004. All rights reserved. subroutine GTVarGetDouble2(var, value, err) use gtdata_types, only: gt_variable use gtdata_generic, only: get_slice, GTVarGetDouble, 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(8) , pointer :: value(:, :) logical, intent(out), optional :: err integer :: stat, n(2) continue call beginsub('gtvargetdouble2', 'var.mapid=%d', i=(/var%mapid/)) call map_set_rank(var, 2, 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.) ! value を allocate (重複 allocate しないようにチェック) if ( associated(value) ) then if ( .not. size(value,1) == n(1) .or. & & .not. size(value,2) == n(2) ) then call DbgMessage('@ nullify value(%d,%d), allocate value(%d,%d)', & & i=(/size(value,1), size(value,2), n(1), n(2)/)) nullify(value) allocate(value(n(1), n(2))) else call DbgMessage('@ value(%d,%d) is already allocated', i=(/n(1),n(2)/)) endif else call DbgMessage('@ allocate value(%d,%d)', i=(/n(1),n(2)/)) allocate(value(n(1), n(2))) endif call GTVarGetDouble(var, value, product(n), err) call DbgMessage('max=%f min=%f', d=(/maxval(value), minval(value)/)) 999 continue call endsub('gtvargetdouble2', 'n=%d', i=(/n/)) call storeerror(stat, 'gtvargetdouble2') end subroutine