add option to set parameters from the command-line
This commit is contained in:
Michele Guerini Rocco
parent
3e49247d15
commit
e81308d048
GPG Key ID:
BFBAF4C975F76450
1
.gitignore
vendored
1
.gitignore
vendored
@ -2,3 +2,4 @@
|
||||
build
|
||||
configure.mk
|
||||
result
|
||||
src/gray_cli_params.f90
|
||||
|
||||
17
Makefile
17
Makefile
@ -12,18 +12,20 @@
|
||||
# └── build - build artifacts
|
||||
# ├── bin - binaries
|
||||
# ├── lib - libraries
|
||||
# └── obj - objects
|
||||
# ├── obj - objects
|
||||
# └── inc - files to #include
|
||||
SRCDIR = src
|
||||
BUILDDIR = build
|
||||
SHAREDIR = build/share
|
||||
BINDIR = build/bin
|
||||
LIBDIR = build/lib
|
||||
OBJDIR = build/obj
|
||||
INCDIR = build/inc
|
||||
|
||||
PREFIX ?= /usr/bin
|
||||
|
||||
# Directories that need to be created
|
||||
DIRS = $(BINDIR) $(OBJDIR) $(LIBDIR) $(SHAREDIR)
|
||||
DIRS = $(BINDIR) $(OBJDIR) $(INCDIR) $(LIBDIR) $(SHAREDIR)
|
||||
|
||||
##
|
||||
## Files
|
||||
@ -32,7 +34,7 @@ DIRS = $(BINDIR) $(OBJDIR) $(LIBDIR) $(SHAREDIR)
|
||||
# All Fortran source files
|
||||
SOURCES = $(wildcard $(SRCDIR)/*.f90)
|
||||
|
||||
# All Generated makefiles describing object dependencies
|
||||
# All Fortran object
|
||||
OBJECTS = $(patsubst $(SRCDIR)/%.f90,$(OBJDIR)/%.o,$(SOURCES))
|
||||
|
||||
# Generated makefiles describing object dependencies
|
||||
@ -64,7 +66,7 @@ GIT_DIRTY ?= $(shell test -n "$$(git status --porcelain)" && echo "-dirty")
|
||||
# Note: can't use ?= for FC because GNU Make defaults to f77
|
||||
FC = gfortran
|
||||
LD = gfortran
|
||||
FFLAGS += -O3 -J$(OBJDIR) -ffree-line-length-none
|
||||
FFLAGS += -O3 -J$(OBJDIR) -I$(INCDIR) -ffree-line-length-none
|
||||
CPPFLAGS += -DREVISION=\"$(GIT_REV)$(GIT_DIRTY)\" -DPREFIX=\"$(PREFIX)\"
|
||||
|
||||
# Static build options
|
||||
@ -150,14 +152,19 @@ $(OBJDIR)/%.d: $(SRCDIR)/%.f90 | $(OBJDIR)
|
||||
sed -nE 's@^[[:blank:]]*use[[:blank:]]+'\
|
||||
'([^,[:blank:]&]+).*@$(OBJDIR)/\1.o \\@p' | \
|
||||
sort -u >> '$@'
|
||||
@sed -nE 's@^#include "(.+)"@$(INCDIR)/\1 \\\n@p' '$<' >> '$@'
|
||||
|
||||
# Load the generated rules
|
||||
include $(DEPS)
|
||||
|
||||
# Compile a generic Fortran source
|
||||
$(OBJDIR)/%.o: $(SRCDIR)/%.f90 | $(OBJDIR)
|
||||
$(OBJDIR)/%.o: $(SRCDIR)/%.f90 | $(OBJDIR) $(INCDIR)
|
||||
$(FC) -cpp $(CPPFLAGS) $(FFLAGS) -c '$<' -o '$@'
|
||||
|
||||
# Generate Fortran code from shell script
|
||||
$(INCDIR)/%.inc: $(SRCDIR)/%.sh | $(INCDIR)
|
||||
sh '$<' > '$@'
|
||||
|
||||
# Create directories
|
||||
$(DIRS):
|
||||
mkdir -p '$@'
|
||||
|
||||
2
depend
2
depend
@ -15,6 +15,8 @@ walk_dag(){
|
||||
while read -r line; do
|
||||
# skip the first line (file own name)
|
||||
contains "$line" ': ' && continue
|
||||
# only look up object files
|
||||
contains "$line" '.o ' || continue
|
||||
line="${line% \\}"
|
||||
contains "$visited" "$line" && continue
|
||||
visited="$line:$visited"
|
||||
|
||||
113
src/gray_cli.f90
113
src/gray_cli.f90
@ -8,6 +8,7 @@ module gray_cli
|
||||
! 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
|
||||
@ -21,7 +22,8 @@ module gray_cli
|
||||
end type
|
||||
|
||||
private
|
||||
public :: cli_options, print_cli_options, parse_cli_options
|
||||
public :: cli_options, print_cli_options, parse_cli_options, &
|
||||
deinit_cli_options, parse_param_overrides
|
||||
|
||||
contains
|
||||
|
||||
@ -48,7 +50,12 @@ contains
|
||||
print '(a)', ' -p, --params-file FILE set the parameters file'
|
||||
print '(a)', ' (default: gray_params.data)'
|
||||
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)', ' -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;'
|
||||
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,'
|
||||
@ -126,10 +133,12 @@ contains
|
||||
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')
|
||||
@ -159,27 +168,106 @@ contains
|
||||
allocate(opts%units(commas + 1))
|
||||
|
||||
! read the list of table IDs
|
||||
read(temp, *, iostat=error) opts%units
|
||||
if (error .gt. 0) then
|
||||
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 .gt. 0) deallocate(argument)
|
||||
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
|
||||
|
||||
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 :: error, 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 (1)
|
||||
print '(4a)', 'invalid value for ', id, ': ', val
|
||||
deallocate(temp)
|
||||
call exit(1)
|
||||
|
||||
case (2)
|
||||
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
|
||||
|
||||
@ -198,4 +286,19 @@ contains
|
||||
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%sum_filelist)) deallocate(opts%sum_filelist)
|
||||
if (allocated(opts%units)) deallocate(opts%units)
|
||||
end subroutine deinit_cli_options
|
||||
|
||||
end module gray_cli
|
||||
|
||||
@ -228,6 +228,30 @@ contains
|
||||
end subroutine print_parameters
|
||||
|
||||
|
||||
function update_parameter(params, name, value) result(error)
|
||||
! Updates the value of a parameter, addressed by a string
|
||||
! The return error is:
|
||||
! 0 on success;
|
||||
! 1 on invalid parameter value;
|
||||
! 2 on unknown parameter name.
|
||||
!
|
||||
! Ex. update_parameter(params, 'raytracing.nrayr', '10')
|
||||
implicit none
|
||||
|
||||
! function arguments
|
||||
type(gray_parameters), intent(inout) :: params
|
||||
character(len=:), allocatable, intent(in) :: name, value
|
||||
integer :: error
|
||||
|
||||
select case (name)
|
||||
#include "gray_params.inc"
|
||||
case default
|
||||
error = 2
|
||||
end select
|
||||
|
||||
end function update_parameter
|
||||
|
||||
|
||||
subroutine read_parameters(filename, params, unit)
|
||||
use utils, only : get_free_unit
|
||||
use logger, only : log_error
|
||||
|
||||
30
src/gray_params.sh
Normal file
30
src/gray_params.sh
Normal file
@ -0,0 +1,30 @@
|
||||
#!/bin/sh
|
||||
|
||||
# This script generates the very repetitive code for parsing the
|
||||
# GRAY parameters from a string. The output is embedded
|
||||
# into gray_params.f90 using a CPP include directive.
|
||||
|
||||
sets='antenna equilibrium profiles raytracing ecrh_cd output misc'
|
||||
|
||||
# shellcheck disable=SC2034
|
||||
{
|
||||
antenna='alpha beta power psi chi iox ibeam filenm fghz pos w ri phi'
|
||||
equilibrium='ssplps ssplf factb sgnb sgni ixp iequil icocos ipsinorm idesc ifreefmt filenm'
|
||||
profiles='psnbnd sspld factne factte iscal irho iprof filenm'
|
||||
raytracing='rwmax dst nrayr nrayth nstep igrad idst ipass ipol'
|
||||
ecrh_cd='iwarm ilarm imx ieccd'
|
||||
output='ipec nrho istpr istpl'
|
||||
misc='rwall'
|
||||
}
|
||||
|
||||
deref() { eval "echo \$$1"; }
|
||||
|
||||
for set in $sets; do
|
||||
for param in $(deref "$set"); do
|
||||
cat <<EOF
|
||||
case ('$set.$param')
|
||||
read (value, *, iostat=error) params%$set%$param
|
||||
if (error > 0) error = 1
|
||||
EOF
|
||||
done
|
||||
done
|
||||
11
src/main.f90
11
src/main.f90
@ -2,7 +2,8 @@ program main
|
||||
use const_and_precisions, only : wp_, one, zero
|
||||
use logger, only : INFO, ERROR, set_log_level, log_message
|
||||
use units, only : set_active_units, close_units
|
||||
use gray_cli, only : cli_options, parse_cli_options
|
||||
use gray_cli, only : cli_options, parse_cli_options, &
|
||||
deinit_cli_options, parse_param_overrides
|
||||
use gray_core, only : gray_main
|
||||
use gray_params, only : gray_parameters, gray_data, gray_results, &
|
||||
read_parameters, params_set_globals => set_globals
|
||||
@ -27,9 +28,11 @@ program main
|
||||
! Activate the given output units
|
||||
call set_active_units(opts%units)
|
||||
|
||||
! Load the parameters and also copy them into
|
||||
! global variables exported by the gray_params
|
||||
! Load the parameters from file, apply CLI
|
||||
! overrides, and copy them into global
|
||||
! variables exported by the gray_params
|
||||
call read_parameters(opts%params_file, params)
|
||||
call parse_param_overrides(params)
|
||||
call params_set_globals(params)
|
||||
|
||||
! Read the input data and set the global variables
|
||||
@ -125,6 +128,7 @@ program main
|
||||
close(100 + i)
|
||||
end do
|
||||
deallocate(dpdv, jcd, jphi, currins, pins, rtin, rpin)
|
||||
deallocate(opts%params_file)
|
||||
end block sum
|
||||
else
|
||||
call gray_main(params, data, results, err)
|
||||
@ -142,6 +146,7 @@ program main
|
||||
call deinit_equilibrium(data%equilibrium)
|
||||
call deinit_profiles(data%profiles)
|
||||
call deinit_misc
|
||||
call deinit_cli_options(opts)
|
||||
deallocate(results%dpdv, results%jcd)
|
||||
call close_units
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user