369
370
371
372
377 implicit none
378 type(GT_HISTORY), intent(in):: history
379 character(len = *), intent(in):: dimname
380 integer, intent(out), optional:: ord
381 integer:: ordwork
382 character(len = STRING):: name, cause_c
383 integer:: i, stat
384 character(len = *), parameter:: subname = 'lookup_dimension'
385 continue
386 call beginsub(subname,
'dimname=%c', c1=trim(dimname))
388 if (present(ord)) ord = 0
389 ordwork = 0
390 if (associated(history % dimvars)) then
391 do, i = 1, size(history % dimvars)
392 call inquire(history % dimvars(i), name=name)
393 if (name == trim(dimname)) then
394 result = history % dimvars(i)
395 if (present(ord)) ord = i
397 cause_c = ""
398 goto 999
399 endif
400 enddo
401 endif
402 if (present(ord)) then
403 ord = 0
404 else
406 cause_c = dimname
407 endif
408999 continue
409 call storeerror(stat, subname, cause_c=cause_c)
410 if (present(ord)) ordwork = ord
411 call endsub(subname,
'ord=%d (0:not found)', i=(/ordwork/))
subroutine, public storeerror(number, where, err, cause_c, cause_i)
integer, parameter, public dc_noerr
Error storage variables
integer, parameter, public gt_ebaddimname
subroutine, public dbgmessage(fmt, i, r, d, l, n, c1, c2, c3, ca)
subroutine, public beginsub(name, fmt, i, r, d, l, n, c1, c2, c3, ca, version)
subroutine, public endsub(name, fmt, i, r, d, l, n, c1, c2, c3, ca)
Provides kind type parameter values.
integer, parameter, public string
Character length for string