! Copyright (C) GFD Dennou Club, 2004. All rights reserved. subroutine GTVarGetDouble1(var, value, err) use gtdata_types, only: gt_variable use gtdata_generic, only: get_slice, get, 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 continue call beginsub('gtvargetdouble1', 'var.mapid=%d', i=(/var%mapid/)) call map_set_rank(var, 1, stat) if (stat /= dc_noerr) goto 999 call get_slice(var, dimord=1, count=n, count_compact=.false.) if (n < 0) then ! count_compact ではないので、ゼロ次元化していると n = -1 となる n = 1 endif ! value を allocate (重複 allocate しないようにチェック) if ( associated(value) ) then if (.not. size(value) == n) then call DbgMessage('@ nullify value(%d), allocate value(%d)', & & i=(/size(value), n/)) nullify(value) allocate(value(n)) else call DbgMessage('@ value(%d) is already allocated', i=(/n/)) endif else call DbgMessage('@ allocate value(%d)', i=(/n/)) allocate(value(n)) endif call get(var, value, n, err) call DbgMessage('max=%f min=%f', d=(/maxval(value), minval(value)/)) 999 continue call endsub('gtvargetdouble1', 'n=%d', i=(/n/)) call storeerror(stat, 'gtvargetdouble1') end subroutine