556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
572 use dc_string, only: stoa, stoi, printf, concat, joinchar, uchar, lchar
573 use dc_present, only: present_and_true
574 use dc_message, only: messagenotify
576 implicit none
577 type(ARGS), intent(inout) :: arg
578 logical, intent(in), optional :: force
579 logical :: OPT_help, found, end
580 character(STRING) :: VAL_help, options_msg, help_msg, category
581 character(STRING), pointer :: localopts(:) => null()
582 integer :: unit, i
583 character(len = *), parameter :: subname = 'DCArgsHelp'
584 continue
585 if (.not. arg % initialized) then
586 call messagenotify('W', subname, 'Call Open before Help in dc_args.')
587 call dcargsopen(arg)
588 end if
589 call dcargsoption(arg, stoa('-h', '-H', '--help'), opt_help, val_help, &
590 & help="display this help and exit. " // &
591 & "VAL is unit number (default is standard output)")
592 if (.not. opt_help .and. .not. present_and_true(force)) then
593 return
594 end if
595 if (trim(val_help) == '') then
597 else
598 unit = stoi(val_help)
599 end if
600
601 call printf(unit, '')
602
603 call dchashget(arg % helpmsg,
'TITLE', help_msg, found)
604 if (found) then
605 call printf(unit, '%c', c1=trim(help_msg))
606 call printf(unit, '')
608 end if
609
610 call dchashget(arg % helpmsg,
'OVERVIEW', help_msg, found)
611 if (found) then
612 call printf(unit, 'Overview::')
613 call printautolinefeed(unit, help_msg, indent=' ')
614 call printf(unit, '')
616 end if
617
618 call dchashget(arg % helpmsg,
'USAGE', help_msg, found)
619 if (found) then
620 call printf(unit, 'Usage::')
621 call printautolinefeed(unit, help_msg, indent=' ')
622 call printf(unit, '')
624 end if
625
626 call printf(unit, 'Options::')
627 if ( associated(arg % opt_table) ) then
628 do i = 1, size(arg % opt_table)
629 options_msg = ' '
630 if (arg % opt_table(i) % optvalue_flag) then
631 call concat(arg % opt_table(i) % options, '=VAL', localopts)
632 else
633 allocate(localopts(size(arg % opt_table(i) % options)))
634 localopts = arg % opt_table(i) % options
635 end if
636 options_msg = trim(options_msg) // trim(joinchar(localopts))
637 deallocate(localopts)
638 call printf(unit, ' %c', c1=trim(options_msg))
639 call printautolinefeed(unit, &
640 & arg % opt_table(i) % help_message, indent=' ')
641 call printf(unit, '')
642 end do
643 end if
644
646 do
647 call dchashnext(arg % helpmsg, category, help_msg,
end)
648 if (end) exit
649
650 call printf(unit, '%c%c::', &
651 & c1=trim(uchar(category(1:1))), c2=trim(lchar(category(2:))))
652 call printautolinefeed(unit, help_msg, indent=' ')
653 call printf(unit, '')
654
655 enddo
656
657 call dcargsclose(arg)
658
659 stop
Provides kind type parameter values.
integer, parameter, public stdout
Unit number for Standard OUTPUT
integer, parameter, public string
Character length for string