6010a9361b
This adds a new configuration file based on the INI format. The new format will allow adding GRAY parameters without breaking compatibility with existing configurations, unlike as of the old gray_params.data.
314 lines
10 KiB
Fortran
314 lines
10 KiB
Fortran
! This module implements the command-line interface (CLI) of GRAY
|
|
module gray_cli
|
|
|
|
implicit none
|
|
|
|
! GRAY command line options
|
|
! See print_help() for a description.
|
|
! Note: if you change these, remember to update:
|
|
! 1. the print_help() subroutine
|
|
! 2. the print_cli_options() subroutine
|
|
! 3. the man page
|
|
type cli_options
|
|
! Switches
|
|
logical :: quiet
|
|
! Files
|
|
character(len=:), allocatable :: output_dir
|
|
character(len=:), allocatable :: params_file
|
|
character(len=:), allocatable :: config_file
|
|
character(len=:), allocatable :: sum_filelist
|
|
! others
|
|
integer :: verbose
|
|
integer, allocatable :: units(:)
|
|
end type
|
|
|
|
private
|
|
public :: cli_options, print_cli_options, parse_cli_options, &
|
|
deinit_cli_options, parse_param_overrides
|
|
|
|
contains
|
|
|
|
subroutine print_help()
|
|
! Prints the usage screen
|
|
|
|
print '(a)', 'Usage: gray [OPTIONS]'
|
|
print '(a)', ''
|
|
print '(a)', 'GRAY is a beam-tracing code for Electron Cyclotron (EC) waves in a tokamak.'
|
|
print '(a)', 'It is based on the complex eikonal theory (quasi-optics), which can accurately'
|
|
print '(a)', 'describe the propagation of a Gaussian beam, diffraction effects included.'
|
|
print '(a)', 'In addition, power absoption and current drive are computed using the fully'
|
|
print '(a)', 'relativistic dispersion relation and a neoclassical response function,'
|
|
print '(a)', 'respectively.'
|
|
print '(a)', ''
|
|
print '(a)', 'Options:'
|
|
print '(a)', ' -h, --help display this help and exit'
|
|
print '(a)', ' -V, --version display version information and exit'
|
|
print '(a)', ' -v, --verbose print more information messages;'
|
|
print '(a)', ' repeating -v increase the log verbosity'
|
|
print '(a)', ' -q, --quiet suppress all non-critical messages'
|
|
print '(a)', ' -o, --output-dir DIR specify where to write the output files'
|
|
print '(a)', ' (default: current directory)'
|
|
print '(a)', ' -p, --params-file FILE set the (legacy) parameters file'
|
|
print '(a)', ' (default: gray_params.data)'
|
|
print '(a)', ' -c, --config-file FILE set the (new) GRAY config file'
|
|
print '(a)', ' (default: gray.ini)'
|
|
print '(a)', ' -s, --sum FILE sum the output profiles from a list of files'
|
|
print '(a)', ' -u, --units ID[,ID...] select which units to output (default: 4, 7);'
|
|
print '(a)', ' see the manual for all unit IDs.'
|
|
print '(a)', ' -g, --gray-param ID=VAL set a GRAY parameter, overriding the value'
|
|
print '(a)', ' specified via --params-file/--config-file;'
|
|
print '(a)', ' the ID is GROUP.NAME, ex. antenna.fghz;'
|
|
print '(a)', ' see the manual for available parameters.'
|
|
print '(a)', ''
|
|
print '(a)', '*Exit status*'
|
|
print '(a)', ' 0 if OK,'
|
|
print '(a)', ' 1 if technical problems (e.g., invalid arguments, missing input files),'
|
|
print '(a)', ' 2 if serious trouble (e.g., computation failed).'
|
|
print '(a)', ''
|
|
print '(a)', 'Full documentation is available at'
|
|
print '(a)', '<file://'//PREFIX//'/share/doc/manual.html>'
|
|
end subroutine
|
|
|
|
|
|
subroutine print_version()
|
|
! Prints the version information
|
|
|
|
print '(a)', 'gray revision ' // REVISION
|
|
print '(a)', ''
|
|
print '(a)', 'Written by D. Farina, L. Figini, A. Mariani and M. Guerini Rocco.'
|
|
end subroutine
|
|
|
|
|
|
subroutine print_cli_options(opts)
|
|
! Prints the parsed CLI options (for debugging)
|
|
|
|
implicit none
|
|
|
|
! subroutine arguments
|
|
type(cli_options), intent(in) :: opts
|
|
|
|
print '(a)' , 'switches:'
|
|
print '(a,l)' , ' - quiet: ' , opts%quiet
|
|
print '(a)' , 'files:'
|
|
print '(a,a)' , ' output-dir: ' , opts%output_dir
|
|
print '(a,a)' , ' param-file: ' , opts%params_file
|
|
print '(a,a)' , ' sum: ' , opts%sum_filelist
|
|
print '(a)' , 'others:'
|
|
print '(a,20i3)' , ' - units: ' , opts%units
|
|
print '(a,l)' , ' - verbose: ' , opts%verbose
|
|
end subroutine
|
|
|
|
|
|
subroutine parse_cli_options(opts)
|
|
! Parse the CLI arguments and initialise the options
|
|
|
|
use units, only : ucenr, usumm
|
|
use logger, only : WARNING
|
|
|
|
implicit none
|
|
|
|
! subroutine arguments
|
|
type(cli_options), intent(out) :: opts
|
|
|
|
! local variables
|
|
character(len=:), allocatable :: argument, temp
|
|
logical :: skip_next = .false.
|
|
integer :: i, nargs
|
|
integer :: error, commas
|
|
|
|
! Default option values
|
|
opts%verbose = WARNING
|
|
opts%quiet = .false.
|
|
opts%params_file = 'gray_params.data'
|
|
opts%units = [ucenr, usumm]
|
|
|
|
nargs = command_argument_count()
|
|
do i = 1, nargs
|
|
call get_command_string(i, argument)
|
|
|
|
! skip one cycle if the last argument was a value
|
|
if (skip_next) then
|
|
skip_next = .false.
|
|
cycle
|
|
end if
|
|
|
|
! parse an argument (and possibly a value)
|
|
select case (argument)
|
|
case ('-h', '--help')
|
|
call print_help()
|
|
deallocate(argument)
|
|
call exit(0)
|
|
|
|
case ('-V', '--version')
|
|
call print_version()
|
|
deallocate(argument)
|
|
call exit(0)
|
|
|
|
case ('-v', '--verbose')
|
|
opts%verbose = opts%verbose + 1
|
|
|
|
case ('-q', '--quiet')
|
|
opts%quiet = .true.
|
|
|
|
case ('-o', '--output-dir')
|
|
call get_command_string(i + 1, opts%output_dir)
|
|
skip_next = .true.
|
|
|
|
case ('-p', '--params-file')
|
|
call get_command_string(i + 1, opts%params_file)
|
|
skip_next = .true.
|
|
|
|
case ('-c', '--config-file')
|
|
call get_command_string(i + 1, opts%config_file)
|
|
skip_next = .true.
|
|
|
|
case ('-s', '--sum')
|
|
call get_command_string(i + 1, opts%sum_filelist)
|
|
skip_next = .true.
|
|
|
|
case ('-u', '--units')
|
|
call get_command_string(i + 1, temp)
|
|
|
|
! resize the array
|
|
commas = count([(temp(i:i) == ',', i = 1, len(temp))])
|
|
deallocate(opts%units)
|
|
allocate(opts%units(commas + 1))
|
|
|
|
! read the list of table IDs
|
|
read (temp, *, iostat=error) opts%units
|
|
if (error > 0) then
|
|
print '(a,a)', 'invalid table IDs: ', temp
|
|
deallocate(argument)
|
|
deallocate(temp)
|
|
call exit(1)
|
|
end if
|
|
deallocate(temp)
|
|
skip_next = .true.
|
|
|
|
case ('-g', '--gray-param')
|
|
! these overrides are parsed later since they need to
|
|
! be applied to the final gray_parameters structure
|
|
skip_next = .true.
|
|
|
|
case default
|
|
print '(a,a,/)', 'Unknown option: ', argument
|
|
call print_help()
|
|
deallocate(argument)
|
|
call exit(1)
|
|
|
|
end select
|
|
end do
|
|
|
|
! free temporary string
|
|
if (nargs > 0) deallocate(argument)
|
|
end subroutine
|
|
|
|
|
|
subroutine parse_param_overrides(params)
|
|
! Reads GRAY parameters from CLI and overrides `params` accordingly
|
|
|
|
use gray_params, only : gray_parameters, update_parameter
|
|
use ini_parser, only : ERR_VALUE, ERR_UNKNOWN
|
|
|
|
implicit none
|
|
|
|
! subroutine arguments
|
|
type(gray_parameters), intent(inout) :: params
|
|
|
|
! local variables
|
|
character(len=:), allocatable :: argument, temp, id, val
|
|
logical :: skip_next = .false.
|
|
integer :: i, nargs
|
|
integer :: sep
|
|
|
|
nargs = command_argument_count()
|
|
do i = 1, nargs
|
|
call get_command_string(i, argument)
|
|
|
|
! skip one cycle if the last argument was a value
|
|
if (skip_next) then
|
|
skip_next = .false.
|
|
cycle
|
|
end if
|
|
|
|
! parse gray parameters
|
|
select case (argument)
|
|
case ('-g', '--gray-param')
|
|
call get_command_string(i + 1, temp)
|
|
|
|
! split at "=" (id=value)
|
|
sep = findloc([(temp(i:i) == '=', i = 1, len(temp))], .true., 1)
|
|
id = temp(1:sep - 1)
|
|
val = temp(sep + 1:)
|
|
|
|
if (sep == 0) then
|
|
print '(a,a)', 'invalid GRAY parameter declaration: ', temp
|
|
print '(a)', 'correct syntax is ID=VALUE, ex. antenna.alpha=45'
|
|
deallocate(temp)
|
|
call exit(1)
|
|
end if
|
|
|
|
! match the name string to a parameter
|
|
select case (update_parameter(params, id, val))
|
|
case (ERR_VALUE)
|
|
print '(4a)', 'invalid value for ', id, ': ', val
|
|
deallocate(temp)
|
|
call exit(1)
|
|
|
|
case (ERR_UNKNOWN)
|
|
print '(a,a)', 'unknown GRAY parameter: ', id
|
|
deallocate(temp)
|
|
call exit(1)
|
|
end select
|
|
|
|
deallocate(temp)
|
|
skip_next = .true.
|
|
|
|
! skip everything else
|
|
case default
|
|
cycle
|
|
|
|
end select
|
|
end do
|
|
|
|
! free temporary string
|
|
if (nargs > 0) deallocate(argument)
|
|
end subroutine parse_param_overrides
|
|
|
|
|
|
subroutine get_command_string(i, arg)
|
|
! Reads a CLI argument into a deferred-length string
|
|
|
|
implicit none
|
|
|
|
! subroutine arguments
|
|
integer, intent(in) :: i
|
|
character(len=:), allocatable, intent(inout) :: arg
|
|
|
|
! local variables
|
|
integer :: len
|
|
|
|
if (allocated(arg)) deallocate(arg) ! free memory (if needed)
|
|
call get_command_argument(i, length=len) ! get the arg length
|
|
allocate(character(len) :: arg) ! allocate memory
|
|
call get_command_argument(i, arg) ! copy
|
|
end subroutine
|
|
|
|
|
|
subroutine deinit_cli_options(opts)
|
|
! Frees all memory allocated by the parse_cli_options subroutine
|
|
|
|
implicit none
|
|
|
|
! subroutine arguments
|
|
type(cli_options), intent(inout) :: opts
|
|
|
|
if (allocated(opts%output_dir)) deallocate(opts%output_dir)
|
|
if (allocated(opts%params_file)) deallocate(opts%params_file)
|
|
if (allocated(opts%config_file)) deallocate(opts%config_file)
|
|
if (allocated(opts%sum_filelist)) deallocate(opts%sum_filelist)
|
|
if (allocated(opts%units)) deallocate(opts%units)
|
|
end subroutine deinit_cli_options
|
|
|
|
end module gray_cli
|