386 lines
13 KiB
Fortran
386 lines
13 KiB
Fortran
program main
|
||
|
||
#ifdef INTEL
|
||
use ifport, only : chdir, getcwd
|
||
#endif
|
||
use const_and_precisions, only : wp_
|
||
use logger, only : INFO, ERROR, WARNING, set_logger, log_message
|
||
use utils, only : dirname
|
||
use types, only : contour
|
||
use gray_cli, only : cli_options, parse_cli_options, &
|
||
parse_param_overrides
|
||
use gray_core, only : gray_main
|
||
use gray_errors, only : gray_error
|
||
use gray_equil, only : abstract_equil, load_equil
|
||
use gray_plasma, only : abstract_plasma, load_plasma
|
||
use gray_params, only : gray_parameters, gray_results, &
|
||
read_gray_params, read_gray_config, &
|
||
make_gray_header
|
||
implicit none
|
||
|
||
integer :: status ! exit status
|
||
|
||
no_save: block
|
||
|
||
! CLI options
|
||
type(cli_options) :: opts
|
||
|
||
! gray_main subroutine arguments
|
||
type(gray_parameters) :: params ! Inputs
|
||
class(abstract_equil), allocatable :: equil !
|
||
class(abstract_plasma), allocatable :: plasma !
|
||
type(contour) :: limiter !
|
||
type(gray_results) :: results ! Outputs
|
||
integer(kind=gray_error) :: sim_error !
|
||
|
||
! Store the original working directory
|
||
integer :: err
|
||
character(len=256) :: cwd
|
||
err = getcwd(cwd)
|
||
|
||
! Parse the command-line options
|
||
call parse_cli_options(opts)
|
||
|
||
! Initialise logging
|
||
if (opts%quiet) opts%verbose = ERROR
|
||
call set_logger(level=opts%verbose)
|
||
|
||
! Load the parameters from file and move to its directory
|
||
! (all other filepaths are assumed relative to it)
|
||
if (allocated(opts%config_file)) then
|
||
! Use the newer gray.ini configuration file
|
||
call log_message(level=INFO, mod='main', msg='using GRAY INI config')
|
||
call read_gray_config(opts%config_file, params, err)
|
||
if (err /= 0) call exit(1)
|
||
err = chdir(dirname(opts%config_file))
|
||
else
|
||
! Use the legacy gray_params.data file
|
||
call log_message(level=INFO, mod='main', msg='using GRAY params file')
|
||
call read_gray_params(opts%params_file, params, err)
|
||
if (err /= 0) call exit(1)
|
||
err = chdir(dirname(opts%params_file))
|
||
end if
|
||
|
||
if (err /= 0) then
|
||
call log_message(level=ERROR, mod='main', &
|
||
msg='chdir to configuration file directory failed!')
|
||
call exit(1)
|
||
end if
|
||
|
||
! Initialise antenna parameters before parsing the
|
||
! cli arguments, so antenna%pos can be overriden
|
||
call init_antenna(params%antenna, err)
|
||
if (err /= 0) call exit(1)
|
||
|
||
! Apply CLI overrides to the parameters
|
||
call parse_param_overrides(params)
|
||
|
||
! Do some checks on the inputs
|
||
associate (p => params%raytracing)
|
||
if (p%igrad == 1 .and. p%nrayr < 5) then
|
||
p%igrad = 0
|
||
call log_message(level=WARNING, mod='main', &
|
||
msg='igrad = 1 but nrayr < 5: disabling beamtracing')
|
||
end if
|
||
if (p%nrayr == 1) p%nrayth = 1
|
||
|
||
if (p%nrayr > 1) then
|
||
p%rwmax = real(p%nrayr - 1) / max(nint((p%nrayr - 1)/p%rwmax), 1)
|
||
end if
|
||
end associate
|
||
|
||
! Read and initialise the equilibrium and limiter objects
|
||
call load_equil(params%equilibrium, equil, limiter, err)
|
||
if (err /= 0) call exit(1)
|
||
|
||
! Read and initialise the plasma state object
|
||
call load_plasma(params, equil, plasma, err)
|
||
if (err /= 0) call exit(1)
|
||
|
||
! Create a simple limiter, if necessary
|
||
if (.not. allocated(limiter%R) .or. params%raytracing%ipass < 0) then
|
||
call log_message('using fallback limiter', level=INFO, mod='main')
|
||
params%raytracing%ipass = abs(params%raytracing%ipass)
|
||
limiter = make_fallback_limiter(params, equil)
|
||
end if
|
||
|
||
! Get back to the initial directory
|
||
err = chdir(cwd)
|
||
|
||
if (allocated(opts%sum_filelist)) then
|
||
call log_message(level=INFO, mod='main', msg='summing profiles')
|
||
call sum_profiles(params, equil, opts%sum_filelist, opts%output_dir, results)
|
||
status = 0
|
||
else
|
||
! Activate the given output tables
|
||
params%misc%active_tables = opts%tables
|
||
|
||
! Finally run the simulation
|
||
call gray_main(params, equil, plasma, limiter, results, sim_error)
|
||
status = 2 * sim_error
|
||
end if
|
||
|
||
print_res: block
|
||
character(256) :: msg
|
||
write(msg, '(a,g0.3," MW")') 'total absoption: P=', results%pabs
|
||
call log_message(msg, level=INFO, mod='main')
|
||
write(msg, '(a,g0.3," kA")') 'total current drive: I=', results%icd * 1.0e3_wp_
|
||
call log_message(msg, level=INFO, mod='main')
|
||
end block print_res
|
||
|
||
! Change the current directory to output files there
|
||
if (allocated(opts%output_dir)) then
|
||
if (chdir(opts%output_dir) /= 0) then
|
||
call log_message(level=ERROR, mod='main', &
|
||
msg='chdir to output_dir ('//opts%output_dir//') failed!')
|
||
call exit(1)
|
||
end if
|
||
end if
|
||
|
||
! Write results to file
|
||
write_res: block
|
||
integer :: i
|
||
do i = 1, size(results%tables%iter)
|
||
if (.not. associated(results%tables%iter(i)%ptr)) cycle
|
||
|
||
associate (tbl => results%tables%iter(i)%ptr)
|
||
call tbl%save(err, header=make_gray_header(params))
|
||
if (err /= 0) then
|
||
call log_message('failed to save '//trim(tbl%title)//' table', &
|
||
level=ERROR, mod='main')
|
||
status = 1
|
||
end if
|
||
end associate
|
||
end do
|
||
end block write_res
|
||
|
||
end block no_save
|
||
|
||
! Exit status is >1 if any error occurred
|
||
call exit(status)
|
||
|
||
contains
|
||
|
||
subroutine init_antenna(params, err)
|
||
! Reads the wave launcher file (containing the wave frequency, launcher
|
||
! position, direction and beam description) and initialises the respective
|
||
! GRAY parameters.
|
||
use beams, only : read_beam0, read_beam1, read_beam2
|
||
use gray_params, only : antenna_parameters, BEAM_0D, BEAM_1D, BEAM_2D
|
||
|
||
! subroutine arguments
|
||
type(antenna_parameters), intent(inout) :: params
|
||
integer, intent(out) :: err
|
||
|
||
! Note: α, β are loaded from gray_params.data
|
||
select case (params%ibeam)
|
||
case (BEAM_2D)
|
||
! 2 degrees of freedom
|
||
! w(z, α, β), 1/R(z, α, β)
|
||
! FIXME: 1st beam is always selected, iox read from table
|
||
call read_beam2(params, beamid=1, err=err, set_pol=.false.)
|
||
case (BEAM_1D)
|
||
! 1 degree of freedom
|
||
! w(z, α), 1/R(z, α)
|
||
call read_beam1(params, err)
|
||
case (BEAM_0D)
|
||
! fixed w(z), 1/R(z)
|
||
call read_beam0(params, err)
|
||
end select
|
||
end subroutine init_antenna
|
||
|
||
|
||
function make_fallback_limiter(params, equil) result(limiter)
|
||
! Creates a simple rectangular limiter:
|
||
!
|
||
! (R_wall, z_launch+Δz)╔═════╗(R_max, z_launch+Δz)
|
||
! ║4 3║
|
||
! ║ ║
|
||
! ║1 2║
|
||
! (R_wall, z_launch-Δz)╚═════╝(R_max, z_launch-Δz)
|
||
!
|
||
! Note: R_max = { +∞ for vacuum,
|
||
! { R₀+a for analytical model,
|
||
! { grid_r[-1] for numerical data.
|
||
!
|
||
use logger, only : log_info
|
||
use const_and_precisions, only : cm
|
||
|
||
! function arguments
|
||
type(gray_parameters), intent(in) :: params
|
||
class(abstract_equil), intent(in) :: equil
|
||
type(contour) :: limiter
|
||
|
||
! local variables
|
||
real(wp_) :: R_launch, z_launch, R_max, delta_z
|
||
|
||
! Launcher coordinates
|
||
R_launch = norm2(params%antenna%pos(1:2)) * cm
|
||
z_launch = params%antenna%pos(3) * cm
|
||
|
||
! Max vertical distance a ray can travel
|
||
delta_z = abs(params%raytracing%ipass) * &
|
||
params%raytracing%dst * params%raytracing%nstep * cm
|
||
|
||
! Avoid clipping out the launcher
|
||
R_max = max(R_launch, equil%r_range(2))
|
||
|
||
! Build a rectangle
|
||
limiter = contour( &
|
||
Rmin=params%misc%rwall, Rmax=R_max, &
|
||
zmin=z_launch - delta_z, zmax=z_launch + delta_z)
|
||
|
||
end function make_fallback_limiter
|
||
|
||
|
||
subroutine sum_profiles(params, equil, filelist, output_dir, results)
|
||
! Combines the EC profiles obtained from multiple gray runs
|
||
! (of different beams) and recomputes the summary table
|
||
use gray_params, only : gray_parameters
|
||
use gray_equil, only : abstract_equil
|
||
use pec, only : pec_init, postproc_profiles, dealloc_pec, &
|
||
rhot_tab
|
||
|
||
! subroutine arguments
|
||
type(gray_parameters), intent(inout) :: params
|
||
class(abstract_equil), intent(in) :: equil
|
||
character(len=*), intent(in) :: filelist, output_dir
|
||
type(gray_results), intent(inout) :: results
|
||
|
||
! local variables
|
||
real(wp_), dimension(:), allocatable :: jphi
|
||
real(wp_), dimension(:), allocatable :: currins, pins, rtin, rpin
|
||
real(wp_), dimension(:), allocatable :: extracol
|
||
integer :: i, j, k, l, nbeams, ncases, nextracols, irt, err
|
||
character(len=255) :: filename, line, extralabels, fmtstr
|
||
real(wp_), dimension(5) :: sums
|
||
real(wp_) :: jphip, dpdvp, rhotj, rhotjava, rhotp, rhotpav, &
|
||
drhotjava, drhotpav, ratjamx, ratjbmx
|
||
real(wp_) :: drhotp, drhotj, dpdvmx, jphimx
|
||
|
||
! unit numbers
|
||
integer :: list, prof, summ
|
||
integer, allocatable :: beams(:)
|
||
|
||
! Initialise the output profiles
|
||
call pec_init(params%output, equil)
|
||
|
||
associate(nrho =>params%output%nrho)
|
||
allocate(jphi(nrho), currins(nrho), pins(nrho), rtin(nrho), rpin(nrho))
|
||
allocate(results%jcd(nrho), results%dpdv(nrho))
|
||
end associate
|
||
|
||
! Read the list of files to be summed
|
||
open(newunit=list, file=filelist, action='read', status='old', iostat=err)
|
||
if (err /= 0) then
|
||
call log_message(level=ERROR, mod='main', &
|
||
msg='opening file list ('//filelist//') failed!')
|
||
call exit(1)
|
||
end if
|
||
|
||
! Open combined output files
|
||
open(newunit=prof, file=output_dir//'/'//'sum-ec-profiles.txt', action='write')
|
||
open(newunit=summ, file=output_dir//'/'//'sum-summary.txt', action='write')
|
||
|
||
! Move to the filelist directory
|
||
! (the filepaths are assumed relative to it)
|
||
if (chdir(dirname(filelist)) /= 0) then
|
||
call log_message(level=ERROR, mod='main', &
|
||
msg='chdir to file list directory failed!')
|
||
call exit(1)
|
||
end if
|
||
|
||
! Read the filelist header
|
||
read(list, *) nbeams, ncases, nextracols
|
||
allocate(beams(nbeams), extracol(nextracols))
|
||
|
||
! Read the list of files
|
||
do i = 1, nbeams
|
||
read(list, *) filename
|
||
|
||
! Open the summand file
|
||
open(newunit=beams(i), file=filename, &
|
||
action='read', status='old', iostat=err)
|
||
if (err /= 0) then
|
||
call log_message(level=ERROR, mod='main', &
|
||
msg='opening summand file ('//trim(filename)//') failed!')
|
||
call exit(1)
|
||
end if
|
||
|
||
! Copy the Gray header from the ec-profiles file
|
||
do j = 1, 21
|
||
read(beams(i), '(a255)') line
|
||
if (i == 1) write(prof, '(a)') trim(line)
|
||
if (i == 1) write(summ, '(a)') trim(line)
|
||
end do
|
||
|
||
! Copy the column labels
|
||
! Note: for the summary.7 we copy only the first columns
|
||
read(beams(i), '(a255)') line
|
||
if (i == 1) then
|
||
extralabels = line(1:index(line, "ρ_p")-1)
|
||
write(prof, '(a)') trim(line)
|
||
write(summ, '(a,x,a,x,a)') trim(extralabels), &
|
||
"I_cd P_abs J_φ_peak dPdV_peak ρ_max_J ρ_avg_J ρ_max_P", &
|
||
"ρ_avg_P Δρ_avg_J Δρ_avg_P ratio_Ja_max ratio_Jb_max"
|
||
end if
|
||
end do
|
||
close(list)
|
||
|
||
do k = 1, ncases
|
||
jphi = 0
|
||
currins = 0
|
||
pins = 0
|
||
results%jcd = 0
|
||
results%dpdv = 0
|
||
|
||
! Sum the radial profiles
|
||
do j = 1, params%output%nrho
|
||
do i = 1, nbeams
|
||
read(beams(i), *) &
|
||
(extracol(l), l=1,nextracols), rpin(j), rtin(j), sums(1:5), irt
|
||
jphi(j) = sums(1) + jphi(j)
|
||
results%jcd(j) = sums(2) + results%jcd(j)
|
||
results%dpdv(j) = sums(3) + results%dpdv(j)
|
||
currins(j) = sums(4) + currins(j)
|
||
pins(j) = sums(5) + pins(j)
|
||
end do
|
||
! Store the sums
|
||
write(fmtstr, '("(",i0,"(1x,e16.8e3),i5)")') nextracols + 7
|
||
write(prof, trim(fmtstr)) &
|
||
(extracol(l), l=1,nextracols), rpin(j), rtin(j), jphi(j), &
|
||
results%jcd(j), results%dpdv(j), currins(j), pins(j), irt
|
||
end do
|
||
|
||
! Combine the total power, current
|
||
results%pabs = pins(params%output%nrho)
|
||
results%icd = currins(params%output%nrho)
|
||
|
||
! Recompute the summary values
|
||
call postproc_profiles(equil, &
|
||
results%Pabs, results%Icd, rhot_tab, results%dPdV, jphi, &
|
||
rhotpav, drhotpav, rhotjava, drhotjava, dpdvp, jphip, &
|
||
rhotp, drhotp, rhotj, drhotj, dpdvmx, jphimx, ratjamx, ratjbmx)
|
||
|
||
write(fmtstr, '("(",i0,"(1x,e12.5),i5,7(1x,e12.5))")') nextracols+12
|
||
write(summ, trim(fmtstr)) &
|
||
(extracol(l), l=1,nextracols), results%icd, results%pabs, &
|
||
jphip, dpdvp, rhotj, rhotjava, rhotp, rhotpav, drhotjava, &
|
||
drhotpav, ratjamx, ratjbmx
|
||
|
||
! Separate the case
|
||
write(prof, *)
|
||
end do
|
||
|
||
! Close all files
|
||
close(prof); close(summ)
|
||
do i = 1, nbeams
|
||
close(beams(i))
|
||
end do
|
||
|
||
! Free memory
|
||
call dealloc_pec
|
||
end subroutine sum_profiles
|
||
|
||
end program main
|