From 7ed76959d429046bdacc0ea3f324ad45f400a29a Mon Sep 17 00:00:00 2001 From: Michele Guerini Rocco Date: Tue, 12 Sep 2023 16:29:09 +0200 Subject: [PATCH] call exit on errors only in main --- src/beams.f90 | 28 +++++++++++------------ src/coreprofiles.f90 | 29 +++++++++++++++--------- src/equilibrium.f90 | 40 ++++++++++++++++++++------------- src/gray_jetto1beam.f90 | 18 +++++++++------ src/gray_params.f90 | 36 ++++++++++++++--------------- src/gray_params.sh | 4 ++-- src/main.f90 | 50 +++++++++++++++++++++++++++-------------- 7 files changed, 122 insertions(+), 83 deletions(-) diff --git a/src/beams.f90 b/src/beams.f90 index e85c25e..ec06ece 100644 --- a/src/beams.f90 +++ b/src/beams.f90 @@ -4,7 +4,7 @@ module beams contains - subroutine read_beam0(params, unit) + subroutine read_beam0(params, err, unit) ! Reads the wave launcher parameters for the simple case ! where w(z) and 1/R(z) are fixed. ! @@ -34,12 +34,12 @@ contains implicit none ! subroutine arguments - type(antenna_parameters), intent(inout) :: params - integer, intent(in), optional :: unit + type(antenna_parameters), intent(inout) :: params + integer, intent(out) :: err + integer, intent(in), optional :: unit ! local variables integer :: u - integer :: err real(wp_) :: k0, w0(2), z0(2), z_R(2), phi u = get_free_unit(unit) @@ -48,7 +48,7 @@ contains if (err /= 0) then call log_error('opening beams file ('//trim(params%filenm)//') failed!', & mod='beams', proc="read_beam0") - call exit(1) + return end if read(u, *) params%fghz ! Wave frequency (GHz) @@ -78,7 +78,7 @@ contains end subroutine read_beam0 - subroutine read_beam1(params, unit) + subroutine read_beam1(params, err, unit) ! Reads the wave launcher parameters for the case ! where w(z, α) and 1/R(z, α) depend on the launcher angle α. ! @@ -105,7 +105,8 @@ contains ! subroutine arguments type(antenna_parameters), intent(inout) :: params - integer, intent(in), optional :: unit + integer, intent(out) :: err + integer, optional, intent(in) :: unit ! local variables integer :: u, nisteer, i, k, ii @@ -116,7 +117,6 @@ contains type(spline_simple) :: beta, waist1, waist2, & rci1, rci2, phi1, phi2, & x0, y0, z0 - integer :: err u = get_free_unit(unit) @@ -124,7 +124,7 @@ contains if (err /= 0) then call log_error('opening beams file ('//trim(params%filenm)//') failed!', & mod='beams', proc="read_beam1") - call exit(1) + return end if read(u,*) params%fghz read(u,*) nisteer @@ -211,7 +211,7 @@ contains end subroutine read_beam1 - subroutine read_beam2(params, beamid, unit) + subroutine read_beam2(params, beamid, err, unit) ! Reads the wave launcher parameters for the general case ! where w(z, α, β) and 1/R(z, α, β) depend on the launcher angles α, β. @@ -225,8 +225,9 @@ contains ! subroutine arguments type(antenna_parameters), intent(inout) :: params - integer, intent(in) :: beamid - integer, intent(in), optional :: unit + integer, intent(in) :: beamid + integer, intent(out), optional :: err + integer, intent(in), optional :: unit ! local variables character(len=20) :: beamname @@ -252,7 +253,6 @@ contains real(wp_), dimension(1) :: fi integer, parameter :: kspl=1 real(wp_), parameter :: sspl=0.01_wp_ - integer :: err u = get_free_unit(unit) @@ -260,7 +260,7 @@ contains if (err /= 0) then call log_error('opening beams file ('//trim(params%filenm)//') failed!', & mod='beams', proc="read_beam1") - call exit(1) + return end if !======================================================================================= diff --git a/src/coreprofiles.f90 b/src/coreprofiles.f90 index e3a43da..bd042c3 100644 --- a/src/coreprofiles.f90 +++ b/src/coreprofiles.f90 @@ -190,7 +190,7 @@ contains end function fzeff - subroutine read_profiles(filenm, data, unit) + subroutine read_profiles(filenm, data, err, unit) ! Reads the radial plasma profiles from `file` and store them ! into `data`. If given, the file is opened in the `unit` number. ! Format notes: @@ -206,11 +206,11 @@ contains ! subroutine arguments character(len=*), intent(in) :: filenm type(profiles_data), intent(out) :: data + integer, intent(out) :: err integer, optional, intent(in) :: unit ! local variables integer :: u, i, nrows - integer :: err ! Free the arrays when already allocated if (allocated(data%psrad)) deallocate(data%psrad) @@ -225,7 +225,8 @@ contains if (err /= 0) then call log_error('opening profiles file ('//trim(filenm)//') failed!', & mod='coreprofiles', proc="read_profiles") - call exit(1) + err = 1 + return end if read(u, *) nrows @@ -244,7 +245,7 @@ contains end subroutine read_profiles - subroutine read_profiles_an(filenm, data, unit) + subroutine read_profiles_an(filenm, data, err, unit) ! Reads the plasma profiles `data` in the analytical format ! from params%filenm. ! If given, the file is opened in the `unit` number. @@ -266,11 +267,11 @@ contains ! subroutine arguments character(len=*), intent(in) :: filenm type(profiles_data), intent(out) :: data + integer, intent(out) :: err integer, optional, intent(in) :: unit ! local variables integer :: u - integer :: err u = get_free_unit(unit) @@ -283,7 +284,8 @@ contains if (err /= 0) then call log_error('opening profiles file ('//trim(filenm)//') failed!', & mod='coreprofiles', proc='read_profiles_an') - call exit(1) + err = 1 + return end if read (u,*) data%derad(1:3) ! dens0, n1, n2 @@ -338,13 +340,15 @@ contains end subroutine scale_profiles - subroutine set_profiles_spline(params, data, launch_pos) + subroutine set_profiles_spline(params, data, err, launch_pos) ! Computes splines for the plasma profiles data and stores them ! in their respective global variables, see the top of this file. ! ! When `launch_pos` (cartesian launch coordinates in cm) is present, ! the subroutine will also check that the wave launcher is strictly ! outside the reconstructed plasma density boundary. + ! + ! `err` is 1 if I/O errors occured, 2 if other initialisation failed. use gray_params, only : profiles_parameters, profiles_data use logger, only : log_debug, log_info, log_warning, log_error @@ -353,10 +357,11 @@ contains ! subroutine arguments type(profiles_parameters), intent(inout) :: params type(profiles_data), intent(inout) :: data + integer, intent(out) :: err real(wp_), optional, intent(in) :: launch_pos(3) ! local variables - integer :: n, err + integer :: n ! for log messages formatting character(256) :: msg @@ -380,7 +385,10 @@ contains else if (err > 0) then write (msg, '(a, g0)') 'density fit failed with error ', err call log_error(msg, mod='coreprofiles', proc='density') - call exit(1) + err = 2 + return + else + err = 0 end if ! Computation of the polynomial tail parameters @@ -465,7 +473,8 @@ contains 'wave launcher is inside the plasma! ', & 'launcher: ψ=', psi, ' boundary: ψ=', tail%end call log_error(msg, mod='coreprofiles', proc='set_profiles_spline') - call exit(2) + err = 2 + return end if end block end if diff --git a/src/equilibrium.f90 b/src/equilibrium.f90 index c53e186..4708688 100644 --- a/src/equilibrium.f90 +++ b/src/equilibrium.f90 @@ -65,7 +65,7 @@ module equilibrium contains - subroutine read_eqdsk(params, data, unit) + subroutine read_eqdsk(params, data, err, unit) ! Reads the MHD equilibrium `data` from a G-EQDSK file (params%filenm). ! If given, the file is opened in the `unit` number. ! For a description of the G-EQDSK, see the GRAY user manual. @@ -79,6 +79,7 @@ contains ! subroutine arguments type(equilibrium_parameters), intent(in) :: params type(equilibrium_data), intent(out) :: data + integer, intent(out) :: err integer, optional, intent(in) :: unit ! local variables @@ -86,7 +87,6 @@ contains character(len=48) :: string real(wp_) :: dr, dz, dps, rleft, zmid, zleft, psiedge, psiaxis real(wp_) :: xdum ! dummy variable, used to discard data - integer :: err u = get_free_unit(unit) @@ -95,7 +95,8 @@ contains if (err /= 0) then call log_error('opening eqdsk file ('//trim(params%filenm)//') failed!', & mod='equilibrium', proc='read_eqdsk') - call exit(1) + err = 1 + return end if ! get size of main arrays and allocate them @@ -191,7 +192,7 @@ contains end subroutine read_eqdsk - subroutine read_equil_an(filenm, ipass, data, unit) + subroutine read_equil_an(filenm, ipass, data, err, unit) ! Reads the MHD equilibrium `data` in the analytical format ! from params%filenm. ! If given, the file is opened in the `unit` number. @@ -207,11 +208,11 @@ contains character(len=*), intent(in) :: filenm integer, intent(in) :: ipass type(equilibrium_data), intent(out) :: data + integer, intent(out) :: err integer, optional, intent(in) :: unit ! local variables integer :: i, u, nlim - integer :: err real(wp_) :: rr0m, zr0m, rpam, b0 u = get_free_unit(unit) @@ -220,7 +221,8 @@ contains if (err /= 0) then call log_error('opening equilibrium file ('//trim(filenm)//') failed!', & mod='equilibrium', proc='read_equil_an') - call exit(1) + err = 1 + return end if read(u, *) rr0m, zr0m, rpam @@ -374,7 +376,7 @@ contains end subroutine scale_equil - subroutine set_equil_spline(params, data) + subroutine set_equil_spline(params, data, err) ! Computes splines for the MHD equilibrium data and stores them ! in their respective global variables, see the top of this file. use const_and_precisions, only : zero, one @@ -387,8 +389,9 @@ contains implicit none ! subroutine arguments - type(equilibrium_parameters), intent(in) :: params - type(equilibrium_data), intent(in) :: data + type(equilibrium_parameters), intent(in) :: params + type(equilibrium_data), intent(in) :: data + integer, intent(out) :: err ! local variables integer :: nr, nz, nrest, nzest, npsest, nrz, npsi, nbnd, ibinf, ibsup @@ -396,7 +399,7 @@ contains real(wp_) :: rbmin, rbmax, rbinf, rbsup, r1, z1 real(wp_), dimension(size(data%psinr)) :: rhotn real(wp_), dimension(:), allocatable :: rv1d, zv1d, fvpsi, wf - integer :: ier, ixploc, info, i, j, ij + integer :: ixploc, info, i, j, ij character(256) :: msg ! for log messages formatting ! compute array sizes @@ -468,10 +471,11 @@ contains rmnm, rmxm, zmnm, zmxm, & psi_spline%knots_x, psi_spline%nknots_x, & psi_spline%knots_y, psi_spline%nknots_y, & - psi_spline%coeffs, ier) + psi_spline%coeffs, err) ! if failed, re-fit with an interpolating spline (zero tension) - if(ier == -1) then + if(err == -1) then + err = 0 tension = 0 psi_spline%nknots_x=nr/4+4 psi_spline%nknots_y=nz/4+4 @@ -479,7 +483,7 @@ contains rmnm, rmxm, zmnm, zmxm, & psi_spline%knots_x, psi_spline%nknots_x, & psi_spline%knots_y, psi_spline%nknots_y, & - psi_spline%coeffs, ier) + psi_spline%coeffs, err) end if deallocate(rv1d, zv1d, wf, fvpsi) ! reset nrz to the total number of grid points for next allocations @@ -494,17 +498,23 @@ contains ! compute spline coefficients call psi_spline%init(data%rv, data%zv, fvpsi, nr, nz, & range=[rmnm, rmxm, zmnm, zmxm], & - tension=params%ssplps, err=ier) + tension=params%ssplps, err=err) ! if failed, re-fit with an interpolating spline (zero tension) - if(ier == -1) then + if(err == -1) then call psi_spline%init(data%rv, data%zv, fvpsi, nr, nz, & range=[rmnm, rmxm, zmnm, zmxm], & tension=zero) + err = 0 end if deallocate(fvpsi) end if + if (err /= 0) then + err = 2 + return + end if + ! compute spline coefficients for ψ(R,z) partial derivatives call psi_spline%init_deriv(nr, nz, 1, 0) ! ∂ψ/∂R call psi_spline%init_deriv(nr, nz, 0, 1) ! ∂ψ/∂z diff --git a/src/gray_jetto1beam.f90 b/src/gray_jetto1beam.f90 index d080dbe..d1a66bc 100644 --- a/src/gray_jetto1beam.f90 +++ b/src/gray_jetto1beam.f90 @@ -1,6 +1,6 @@ subroutine gray_jetto1beam(ijetto, mr, mz, r, z, psin, psia, rax, zax, & nbnd, rbnd, zbnd, nrho, psrad, fpol, te, dne, zeff, qpsi, ibeam, & - p0mw, alphain, betain, dpdv, jcd, pabs, icd, error) + p0mw, alphain, betain, dpdv, jcd, pabs, icd, err) use const_and_precisions, only: wp_ use units, only: set_active_units, close_units use gray_params, only: gray_parameters, gray_data, gray_results @@ -18,7 +18,7 @@ subroutine gray_jetto1beam(ijetto, mr, mz, r, z, psin, psia, rax, zax, & real(wp_), dimension(nrho), intent(in) :: psrad, fpol, te, dne, zeff, qpsi real(wp_), dimension(nrho), intent(out) :: dpdv, jcd real(wp_), intent(out) :: pabs, icd - integer, intent(out) :: error + integer, intent(out) :: err ! local variables type(gray_parameters) :: params @@ -43,7 +43,8 @@ subroutine gray_jetto1beam(ijetto, mr, mz, r, z, psin, psia, rax, zax, & ! Read parameters from external file init_params: block use gray_params, only : read_gray_params, set_globals - call read_gray_params('gray.data', params) + call read_gray_params('gray.data', params, err) + if (err /= 0) return ! Override some parameters params%misc%rwall = r(1) @@ -93,7 +94,8 @@ subroutine gray_jetto1beam(ijetto, mr, mz, r, z, psin, psia, rax, zax, & data%equilibrium%qpsi = qpsi ! Compute splines - call set_equil_spline(params%equilibrium, data%equilibrium) + call set_equil_spline(params%equilibrium, data%equilibrium, err) + if (err /= 0) return end block init_equilibrium ! Set plasma kinetic profiles @@ -106,7 +108,8 @@ subroutine gray_jetto1beam(ijetto, mr, mz, r, z, psin, psia, rax, zax, & data%profiles%zfc = zeff ! Compute splines - call set_profiles_spline(params%profiles, data%profiles) + call set_profiles_spline(params%profiles, data%profiles, err) + if (err /= 0) return end block init_profiles ! Set wave launcher parameters @@ -119,11 +122,12 @@ subroutine gray_jetto1beam(ijetto, mr, mz, r, z, psin, psia, rax, zax, & params%antenna%power = p0mw ! Read beam description file - call read_beam2(params%antenna, beamid=ibeam) + call read_beam2(params%antenna, beamid=ibeam, err=err) + if (err /= 0) return end block init_antenna ! Call main subroutine for the ibeam-th beam - call gray_main(params, data, res, error, rhout=sqrt(psrad)) + call gray_main(params, data, res, err, rhout=sqrt(psrad)) ! Free memory free_memory: block diff --git a/src/gray_params.f90 b/src/gray_params.f90 index 365351f..8c15d4f 100644 --- a/src/gray_params.f90 +++ b/src/gray_params.f90 @@ -243,7 +243,7 @@ contains end subroutine print_parameters - function update_parameter(params, name, value) result(error) + function update_parameter(params, name, value) result(err) ! Updates the value of a parameter, addressed by a string ! The return error is: ! ERR_SUCCESS on success; @@ -258,42 +258,41 @@ contains ! function arguments type(gray_parameters), intent(inout) :: params character(*), intent(in) :: name, value - integer(kind(ini_error)) :: error + integer(kind(ini_error)) :: err ! hope for the best... - error = ERR_SUCCESS + err = ERR_SUCCESS select case (name) #include "gray_params.inc" case default ! unknown parameter - error = ERR_UNKNOWN + err = ERR_UNKNOWN end select end function update_parameter - subroutine read_gray_config(filename, params) + subroutine read_gray_config(filename, params, err) ! Reads the GRAY parameters from the gray.ini configuration file - use ini_parser, only : parse_ini, property_handler, ini_error, ERR_SUCCESS + use ini_parser, only : parse_ini, property_handler, ini_error implicit none ! subroutine arguments - character(len=*), intent(in) :: filename - type(gray_parameters), intent(out) :: params + character(len=*), intent(in) :: filename + type(gray_parameters), intent(out) :: params + integer(kind(ini_error)), intent(out) :: err ! local variables procedure(property_handler), pointer :: p - integer :: error p => ini_handler - call parse_ini(filename, p, error) - if (error /= ERR_SUCCESS) call exit(1) + call parse_ini(filename, p, err) contains - function ini_handler(section, name, value) result(error) + function ini_handler(section, name, value) result(err) ! This function handles a single INI property and updates ! the `params` structure @@ -301,15 +300,15 @@ contains ! function arguments character(*), intent(in) :: section, name, value - integer(kind(ini_error)) :: error + integer(kind(ini_error)) :: err - error = update_parameter(params, section // "." // name, value) + err = update_parameter(params, section // "." // name, value) end function ini_handler end subroutine read_gray_config - subroutine read_gray_params(filename, params) + subroutine read_gray_params(filename, params, err) ! Reads the GRAY parameters from the legacy gray_params.data file use utils, only : get_free_unit use logger, only : log_error @@ -317,11 +316,12 @@ contains implicit none ! subrouting arguments - character(len=*), intent(in) :: filename + character(len=*), intent(in) :: filename type(gray_parameters), intent(out) :: params + integer, intent(out) :: err ! local variables - integer :: u, err + integer :: u u = get_free_unit() @@ -329,7 +329,7 @@ contains if (err /= 0) then call log_error('opening gray_params file ('//filename//') failed!', & mod='gray_params', proc='read_gray_params') - call exit(1) + return end if read(u, *) params%raytracing%nrayr, params%raytracing%nrayth, & diff --git a/src/gray_params.sh b/src/gray_params.sh index ea0a9e1..ae21d72 100644 --- a/src/gray_params.sh +++ b/src/gray_params.sh @@ -23,8 +23,8 @@ for set in $sets; do for param in $(deref "$set"); do cat < 0) error = ERR_VALUE + read (value, *, iostat=err) params%$set%$param + if (err > 0) err = ERR_VALUE EOF done done diff --git a/src/main.f90 b/src/main.f90 index 804c270..c1444d5 100644 --- a/src/main.f90 +++ b/src/main.f90 @@ -40,12 +40,14 @@ program main 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) + 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) + call read_gray_params(opts%params_file, params, err) + if (err /= 0) call exit(1) err = chdir(dirname(opts%params_file)) end if @@ -62,10 +64,16 @@ program main ! Read the input data and set the global variables ! of the respective module. Note: order matters. - call init_equilibrium(params, data) - call init_antenna(params%antenna) + call init_antenna(params%antenna, err) + if (err /= 0) call exit(err) + + call init_equilibrium(params, data, err) + if (err /= 0) call exit(err) + call init_profiles(params%profiles, params%equilibrium%factb, & - params%antenna%pos, data%profiles) + params%antenna%pos, data%profiles, err) + if (err /= 0) call exit(err) + call init_misc(params, data) ! Change the current directory to output files there @@ -188,7 +196,7 @@ program main contains - subroutine init_equilibrium(params, data) + subroutine init_equilibrium(params, data, err) ! Reads the MHD equilibrium file (either in the G-EQDSK format ! or an analytical description) and initialises the respective ! GRAY parameters and data. @@ -201,6 +209,7 @@ contains ! subroutine arguments type(gray_parameters), intent(inout) :: params type(gray_data), intent(out) :: data + integer, intent(out) :: err if (params%equilibrium%iequil < 2) then ! Analytical equilibrium @@ -208,7 +217,8 @@ contains mod='main', proc='init_equilibrium') call read_equil_an(params%equilibrium%filenm, & params%raytracing%ipass, & - data%equilibrium) + data%equilibrium, err) + if (err /= 0) return ! Set psia sign to give the correct sign to Iphi ! (COCOS=3: psia<0 for Iphi>0) @@ -218,7 +228,8 @@ contains ! Numerical equilibrium call log_debug('loading G-EQDK file', & mod='main', proc='init_equilibrium') - call read_eqdsk(params%equilibrium, data%equilibrium) + call read_eqdsk(params%equilibrium, data%equilibrium, err) + if (err /= 0) return call change_cocos(data%equilibrium, params%equilibrium%icocos, 3) end if @@ -230,7 +241,8 @@ contains call set_equil_an(data%equilibrium) else call log_debug('computing splines...', mod='main', proc='init_equilibrium') - call set_equil_spline(params%equilibrium, data%equilibrium) + call set_equil_spline(params%equilibrium, data%equilibrium, err) + if (err /= 0) return call log_debug('splines computed', mod='main', proc='init_equilibrium') end if end subroutine init_equilibrium @@ -257,7 +269,7 @@ contains end subroutine deinit_equilibrium - subroutine init_profiles(params, factb, launch_pos, data) + subroutine init_profiles(params, factb, launch_pos, data, err) ! Reads the plasma kinetic profiles file (containing the elecron ! temperature, density and plasma effective charge) and initialises ! the respective GRAY data structure. @@ -275,17 +287,20 @@ contains real(wp_), intent(in) :: factb real(wp_), intent(in) :: launch_pos(3) type(profiles_data), intent(out) :: data + integer, intent(out) :: err if (params%iprof == 0) then ! Analytical profiles call log_debug('loading analytical file', & mod='main', proc='init_profiles') - call read_profiles_an(params%filenm, data) + call read_profiles_an(params%filenm, data, err) + if (err /= 0) return else ! Numerical profiles call log_debug('loading numerical file', & mod='main', proc='init_profiles') - call read_profiles(params%filenm, data) + call read_profiles(params%filenm, data, err) + if (err /= 0) return ! Convert psrad to ψ select case (params%irho) @@ -307,7 +322,7 @@ contains else ! Numerical profiles call log_debug('computing splines...', mod='main', proc='init_profiles') - call set_profiles_spline(params, data, launch_pos) + call set_profiles_spline(params, data, err, launch_pos) call log_debug('splines computed', mod='main', proc='init_profiles') end if end subroutine init_profiles @@ -332,7 +347,7 @@ contains end subroutine deinit_profiles - subroutine init_antenna(params) + 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. @@ -343,6 +358,7 @@ contains ! subroutine arguments type(antenna_parameters), intent(inout) :: params + integer, intent(out) :: err ! Note: α, β are loaded from gray_params.data select case (params%ibeam) @@ -350,14 +366,14 @@ contains ! 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) + call read_beam2(params, beamid=1, err=err) case (1) ! 1 degree of freedom ! w(z, α), 1/R(z, α) - call read_beam1(params) + call read_beam1(params, err) case default ! fixed w(z), 1/R(z) - call read_beam0(params) + call read_beam0(params, err) end select end subroutine init_antenna