395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433 use dc_message, only: messagenotify
434 implicit none
435 type(ARGS), intent(inout) :: arg
436 character(len = *), intent(in) :: options(:)
437 logical, intent(out) :: flag
438 character(len = *), intent(out), optional :: value
439 character(len = *), intent(in), optional :: help
440 integer :: i, j, options_size, table_size
441 type(OPT_ENTRY), allocatable :: local_tables(:)
442 character(len = STRING) :: opt_name, opt_value, opt_full
443 character(len = *), parameter :: subname = 'DCArgsOption'
444 continue
445 flag = .false.
446 if (present(value)) value = ''
447 if (.not. arg % initialized) then
448 call messagenotify('W', subname, 'Call Open before Option in dc_args.')
449 call dcargsopen(arg)
450 end if
451 options_size = size(options)
452 if (options_size < 1) then
453 return
454 end if
455
456
457
458
459
460 if ( .not. associated( arg % opt_table ) ) then
461
462
463 table_size = 0
464 allocate(arg % opt_table(table_size + 1))
465 else
466
467
468 table_size = size(arg % opt_table)
469 allocate(local_tables(table_size))
470 local_tables(1:table_size) = arg % opt_table(1:table_size)
471 deallocate(arg % opt_table)
472 allocate(arg % opt_table(table_size + 1))
473 arg % opt_table(1:table_size) = local_tables(1:table_size)
474 deallocate(local_tables)
475 end if
476
477
478 allocate(arg % opt_table(table_size + 1) % options(options_size))
479 arg % opt_table(table_size + 1) % options = options
480 arg % opt_table(table_size + 1) % help_message = ''
481 if (present(help)) then
482 arg % opt_table(table_size + 1) % help_message = help
483 end if
484 arg % opt_table(table_size + 1) % optvalue_flag = present(value)
485
486
487
488 do i = 1, options_size
489 opt_full = arg % opt_table(table_size + 1) % options(i)
490 if (dcoptionformc(opt_full, opt_name, opt_value)) then
491 arg % opt_table(table_size + 1) % options(i) = opt_name
492 else
493 if (len(trim(adjustl(opt_full))) < 2) then
494 arg % opt_table(table_size + 1) % options(i) = &
495 & '-' // trim(adjustl(opt_full))
496 else
497 arg % opt_table(table_size + 1) % options(i) = &
498 & '--' // trim(adjustl(opt_full))
499 end if
500 end if
501 end do
502
503
504
505
506 do i = 1, options_size
507 do j = 1, size(arg % cmd_opts_list)
508 if (trim(arg % opt_table(table_size + 1) % options(i)) &
509 & == trim(arg % cmd_opts_list(j) % name)) then
510 flag = .true.
511 if (present(value)) then
512 value = arg % cmd_opts_list(j) % value
513 end if
514 arg % cmd_opts_list(j) % flag_called = .true.
515 end if
516 end do
517 end do