eq_ops.f90

Go to the documentation of this file.

!------------------------------------------------------------------------------!
!------------------------------------------------------------------------------!
module eq_ops
#include <PB3D_macros.h>
    use str_utilities
    use output_ops
    use messages
    use num_vars, only: pi, dp, max_str_ln, max_deriv
    use grid_vars, only: grid_type
    use eq_vars, only: eq_1_type, eq_2_type
#if ldebug
    use num_utilities, only: check_deriv
#endif
    
    implicit none
    private
    public calc_eq, calc_derived_q, calc_normalization_const, normalize_input, &
        &print_output_eq, flux_q_plot, redistribute_output_eq, divide_eq_jobs, &
        &calc_eq_jobs_lims, calc_t_hf, b_plot, j_plot, kappa_plot, delta_r_plot
#if ldebug
    public debug_calc_derived_q, debug_create_vmec_input, debug_j_plot
#endif
    
    ! global variables
    integer :: fund_n_par
    logical :: BR_normalization_provided(2)                                     ! used to export HELENA to VMEC
#if ldebug
 
    logical :: debug_calc_derived_q = .false.                                   
    logical :: debug_j_plot = .false.                                           
    logical :: debug_create_vmec_input = .false.                                
#endif
    
    ! interfaces
    
    interface calc_eq
        module procedure calc_eq_1
        module procedure calc_eq_2
    end interface
    
    interface print_output_eq
        module procedure print_output_eq_1
        module procedure print_output_eq_2
    end interface
    
    interface redistribute_output_eq
        module procedure redistribute_output_eq_1
        module procedure redistribute_output_eq_2
    end interface
 
    interface calc_rzl
        module procedure calc_rzl_ind
        module procedure calc_rzl_arr
    end interface
    
    interface calc_g_c
        module procedure calc_g_c_ind
        module procedure calc_g_c_arr
    end interface
    
    interface calc_g_v
        module procedure calc_g_v_ind
        module procedure calc_g_v_arr
    end interface
    
    interface calc_g_h
        module procedure calc_g_h_ind
        module procedure calc_g_h_arr
    end interface
    
    interface calc_g_f
        module procedure calc_g_f_ind
        module procedure calc_g_f_arr
    end interface
    
    interface calc_jac_v
        module procedure calc_jac_v_ind
        module procedure calc_jac_v_arr
    end interface
    
    interface calc_jac_h
        module procedure calc_jac_h_ind
        module procedure calc_jac_h_arr
    end interface
    
    interface calc_jac_f
        module procedure calc_jac_f_ind
        module procedure calc_jac_f_arr
    end interface
    
    interface calc_t_vc
        module procedure calc_t_vc_ind
        module procedure calc_t_vc_arr
    end interface
    
    interface calc_t_vf
        module procedure calc_t_vf_ind
        module procedure calc_t_vf_arr
    end interface
    
    interface calc_t_hf
        module procedure calc_t_hf_ind
        module procedure calc_t_hf_arr
    end interface
    
contains
    integer function calc_eq_1(grid_eq,eq) result(ierr)
        use num_vars, only: eq_style, rho_style, use_normalization, &
            &use_pol_flux_e, use_pol_flux_f
        use eq_vars, only: rho_0
        use num_utilities, only: derivs
        use eq_utilities, only: calc_f_derivs
        
        character(*), parameter :: rout_name = 'calc_eq_1'
        
        ! input / output
        type(grid_type), intent(inout) :: grid_eq
        type(eq_1_type), intent(inout) :: eq
        
        ! local variables
        character(len=max_str_ln) :: err_msg                                    ! error message
        character(len=max_str_ln) :: file_name                                  ! file name
        character(len=max_str_ln) :: plot_title                                 ! plot title
        
        ! initialize ierr
        ierr = 0
        
        ! user output
        call writo('Start setting up flux equilibrium quantities')
        
        call lvl_ud(1)
        
        ! create equilibrium
        call eq%init(grid_eq)
        
        ! choose which equilibrium style is being used:
        !   1:  VMEC
        !   2:  HELENA
        select case (eq_style)
            case (1)                                                            ! VMEC
                call calc_flux_q_vmec()
            case (2)                                                            ! HELENA
                call calc_flux_q_hel()
        end select
        
        ! tests
        err_msg = 'Check out the FAQ at &
            &https://pb3d.github.io/Doxygen/html/page_faq.html'
        
        ! check whether the coordinate is increasing
        if (grid_eq%r_F(grid_eq%n(3)) .le. grid_eq%r_F(1)) then
            file_name = 'r_F'
            plot_title = 'Flux normal coordinate'
            call print_ex_2d(plot_title,file_name,grid_eq%r_F,draw=.false.)
            call draw_ex([plot_title],file_name,1,1,.false.)
            ierr = 3
            call writo('The code has not been tested satisfactorily for &
                &decreasing normal coordinate. See plot '// trim(file_name),&
                &alert=.true.)
            chckerr(err_msg)
        end if
        
        ! check whether there are reversed shear regions
        if (maxval(eq%q_saf_E(:,1))*minval(eq%q_saf_E(:,1)) .lt. 0._dp) then
            file_name = 'Dq_saf'
            plot_title = 'derivative of safety factor'
            call print_ex_2d(plot_title,file_name,eq%q_saf_E(:,1),draw=.false.)
            call draw_ex([plot_title],file_name,1,1,.false.)
            ierr = 3
            call writo('The code has to be adapted for reversed-shear regions &
                &still. See plot ' // trim(file_name),alert=.true.)
            chckerr(err_msg)
        end if
        
        ! take local variables
        grid_eq%loc_r_E = grid_eq%r_E(grid_eq%i_min:grid_eq%i_max)
        grid_eq%loc_r_F = grid_eq%r_F(grid_eq%i_min:grid_eq%i_max)
        
        ! Transform flux equilibrium E into F derivatives
        ierr = calc_f_derivs(grid_eq,eq)
        chckerr('')
        
        ! Calculate particle density rho
        ! choose which density style is being used:
        !   1:  constant, equal to rho_0
        select case (rho_style)
            case (1)                                                            ! arbitrarily constant (normalized value)
                eq%rho = rho_0
            case default
                err_msg = 'No density style associated with '//&
                    &trim(i2str(rho_style))
                ierr = 1
                chckerr(err_msg)
        end select
        ! normalize rho if necessary
        if (use_normalization) eq%rho = eq%rho/rho_0
        
        call lvl_ud(-1)
        
        call writo('Done setting up flux equilibrium quantities')
    contains
        ! VMEC version
        ! The VMEC normal coord. is  the toroidal (or poloidal) flux, normalized
        ! wrt.  to  the  maximum  flux,  equidistantly,  so  the  step  size  is
        ! 1/(n(3)-1)
        subroutine calc_flux_q_vmec()
            use vmec_vars, only: rot_t_v, q_saf_v, flux_t_v, flux_p_v, pres_v
            use eq_vars, only: max_flux_e
            
            ! copy flux variables
            eq%flux_p_E = flux_p_v(grid_eq%i_min:grid_eq%i_max,:)
            eq%flux_t_E = flux_t_v(grid_eq%i_min:grid_eq%i_max,:)
            eq%pres_E = pres_v(grid_eq%i_min:grid_eq%i_max,:)
            eq%q_saf_E = q_saf_v(grid_eq%i_min:grid_eq%i_max,:)
            eq%rot_t_E = rot_t_v(grid_eq%i_min:grid_eq%i_max,:)
            
            ! max flux and  normal coord. of eq grid  in Equilibrium coordinates
            ! (uses poloidal flux by default)
            if (use_pol_flux_e) then
                grid_eq%r_E = flux_p_v(:,0)/max_flux_e
            else
                grid_eq%r_E = flux_t_v(:,0)/max_flux_e
            end if
            
            ! max flux and normal coord. of eq grid in Flux coordinates
            if (use_pol_flux_f) then
                grid_eq%r_F = flux_p_v(:,0)/(2*pi)                              ! psi_F = flux_p/2pi
            else
                grid_eq%r_F = - flux_t_v(:,0)/(2*pi)                            ! psi_F = flux_t/2pi, conversion VMEC LH -> PB3D RH
            end if
        end subroutine calc_flux_q_vmec
        
        ! HELENA version
        ! The HELENA normal coord. is the poloidal flux divided by 2pi
        subroutine calc_flux_q_hel()
            use helena_vars, only: q_saf_h, rot_t_h, flux_p_h, flux_t_h, pres_h
            use num_utilities, only: calc_int
            
            ! copy flux variables
            eq%flux_p_E = flux_p_h(grid_eq%i_min:grid_eq%i_max,:)
            eq%flux_t_E = flux_t_h(grid_eq%i_min:grid_eq%i_max,:)
            eq%pres_E = pres_h(grid_eq%i_min:grid_eq%i_max,:)
            eq%q_saf_E = q_saf_h(grid_eq%i_min:grid_eq%i_max,:)
            eq%rot_t_E = rot_t_h(grid_eq%i_min:grid_eq%i_max,:)
            
            ! max flux and  normal coord. of eq grid  in Equilibrium coordinates
            ! (uses poloidal flux by default)
            grid_eq%r_E = flux_p_h(:,0)/(2*pi)
            
            ! max flux and normal coord. of eq grid in Flux coordinates
            if (use_pol_flux_f) then
                grid_eq%r_F = flux_p_h(:,0)/(2*pi)                              ! psi_F = flux_p/2pi
            else
                grid_eq%r_F = flux_t_h(:,0)/(2*pi)                              ! psi_F = flux_t/2pi
            end if
        end subroutine calc_flux_q_hel
    end function calc_eq_1
    integer function calc_eq_2(grid_eq,eq_1,eq_2,dealloc_vars) result(ierr)
        use num_vars, only: eq_style, export_hel, tol_zero
        use num_utilities, only: derivs, c
        use eq_utilities, only: calc_inv_met, calc_f_derivs
        use vmec_utilities, only: calc_trigon_factors
#if ldebug
        use num_vars, only: ltest
        use input_utilities, only: get_log, pause_prog
        use helena_ops, only: test_metrics_h, test_harm_cont_h
        use helena_vars, only: chi_h
#endif
        
        character(*), parameter :: rout_name = 'calc_eq_2'
        
        ! input / output
        type(grid_type), intent(inout) :: grid_eq
        type(eq_1_type), intent(in) :: eq_1
        type(eq_2_type), intent(inout) :: eq_2
        logical, intent(in), optional :: dealloc_vars
        
        ! local variables
        integer :: id, jd, kd                                                   ! counters
        integer :: pmone                                                        ! plus or minus one
        logical :: dealloc_vars_loc                                             ! local dealloc_vars
        character(len=max_str_ln) :: err_msg                                    ! error message
        
        ! initialize ierr
        ierr = 0
        
        ! user output
        call writo('Start setting up metric equilibrium quantities')
        
        call lvl_ud(1)
        
        ! set up local dealloc_vars
        dealloc_vars_loc = .false.
        if (present(dealloc_vars)) dealloc_vars_loc = dealloc_vars
        
        ! create metric equilibrium variables
        call eq_2%init(grid_eq)
        
        ! do some preparations depending on equilibrium style used
        !   1:  VMEC
        !   2:  HELENA
        select case (eq_style)
            case (1)                                                            ! VMEC
                ! calculate  the   cylindrical  variables   R,  Z  and   λ  and
                ! derivatives if not yet done
                call writo('Calculate R, Z, λ, ...')
                if (.not.allocated(grid_eq%trigon_factors)) then
                    ierr = calc_trigon_factors(grid_eq%theta_E,grid_eq%zeta_E,&
                        &grid_eq%trigon_factors)
                    chckerr('')
                end if
                do id = 0,max_deriv+1
                    ierr = calc_rzl(grid_eq,eq_2,derivs(id))
                    chckerr('')
                end do
            case (2)                                                            ! HELENA
                ! do nothing
        end select
        
        ! Calcalations depending on equilibrium style being used:
        !   1:  VMEC
        !   2:  HELENA
        select case (eq_style)
            case (1)                                                            ! VMEC
                ! calculate the metrics in the cylindrical coordinate system
                call writo('Calculate g_C')                                     ! h_C is not necessary
                do id = 0,max_deriv
                    ierr = calc_g_c(eq_2,derivs(id))
                    chckerr('')
                end do
                
                ! calculate the transformation matrix C(ylindrical) -> V(MEC)
                call writo('Calculate T_VC')
                do id = 0,max_deriv
                    ierr = calc_t_vc(eq_2,derivs(id))
                    chckerr('')
                end do
                
                ! calculate the metric factors in the VMEC coordinate system
                call writo('Calculate g_V')
                do id = 0,max_deriv
                    ierr = calc_g_v(eq_2,derivs(id))
                    chckerr('')
                end do
                
                ! calculate the jacobian in the VMEC coordinate system
                call writo('Calculate jac_V')
                do id = 0,max_deriv
                    ierr = calc_jac_v(grid_eq,eq_2,derivs(id))
                    chckerr('')
                end do
                
#if ldebug
                if (ltest) then
                    call writo('Test calculation of g_V?')
                    if(get_log(.false.)) then
                        ierr = test_g_v(grid_eq,eq_2)
                        chckerr('')
                        call pause_prog
                    end if
                    call writo('Test calculation of jac_V?')
                    if(get_log(.false.)) then
                        ierr = test_jac_v(grid_eq,eq_2)
                        chckerr('')
                        call pause_prog
                    end if
                end if
#endif
                
                ! calculate the transformation matrix V(MEC) -> F(lux)
                call writo('Calculate T_VF')
                do id = 0,max_deriv
                    ierr = calc_t_vf(grid_eq,eq_1,eq_2,derivs(id))
                    chckerr('')
                end do
                
                ! set up plus minus one
                pmone = -1                                                      ! conversion VMEC LH -> RH coord. system
                
                ! possibly deallocate
                if (dealloc_vars_loc) then
                    deallocate(eq_2%g_C)
                end if
            case (2)                                                            ! HELENA
#if ldebug
                ! Check whether poloidal grid is indeed chi_H
                ! If not,  the boundary  conditions used in  the splines  of the
                ! following routines are not correct.
                ! A  solution to  this problem  would be  to set  up the  HELENA
                ! variables  in  a  full  periodic  grid,  even  when  they  are
                ! top-bottom symmetric.
                do kd = 1,grid_eq%loc_n_r
                    do jd = 1,grid_eq%n(2)
                        do id = 1,grid_eq%n(1)
                            if (abs(grid_eq%theta_E(id,jd,kd)-chi_h(id)).gt.&
                                &tol_zero) then
                                ierr = 1
                                err_msg = 'theta_E is not identical to chi_H'
                                chckerr(err_msg)
                            end if
                            if (abs(grid_eq%zeta_E(id,jd,kd)-0._dp).gt.&
                                &tol_zero) then
                                ierr = 1
                                err_msg = 'zeta_E is not identical to 0'
                                chckerr(err_msg)
                            end if
                        end do
                    end do
                end do
                
                if (ltest) then
                    call writo('Test consistency of metric factors?')
                    if(get_log(.false.,ind=.true.)) then
                        ierr = test_metrics_h()
                        chckerr('')
                        call pause_prog(ind=.true.)
                    end if
                    
                    call writo('Test harmonic content of HELENA output?')
                    if(get_log(.false.,ind=.true.)) then
                        ierr = test_harm_cont_h()
                        chckerr('')
                        call pause_prog(ind=.true.)
                    end if
                end if
#endif
                
                ! calculate the jacobian in the HELENA coordinate system        
                call writo('Calculate jac_H')
                do id = 0,max_deriv
                    ierr = calc_jac_h(grid_eq,eq_1,eq_2,derivs(id))
                    chckerr('')
                end do
                
                ! calculate the metric factors in the HELENA coordinate system
                call writo('Calculate g_H')
                do id = 0,max_deriv
                    ierr = calc_g_h(grid_eq,eq_2,derivs(id))
                    chckerr('')
                end do
                
                ! calculate the inverse h_H of the metric factors g_H
                call writo('Calculate h_H')
                do id = 0,max_deriv
                    ierr = calc_inv_met(eq_2%h_E,eq_2%g_E,derivs(id))
                    chckerr('')
                end do
                
#if ldebug
                if (ltest) then
                    call writo('Test calculation of D1 D2 h_H?')
                    if(get_log(.false.)) then
                        ierr = test_d12h_h(grid_eq,eq_2)
                        chckerr('')
                        call pause_prog
                    end if
                end if
#endif
                
                ! export for VMEC port
                if (export_hel) then
                    call writo('Exporting HELENA equilibrium for VMEC porting')
                    call lvl_ud(1)
                    ierr = create_vmec_input(grid_eq,eq_1)
                    chckerr('')
                    call lvl_ud(-1)
                    call writo('Done exporting')
                end if
                
                ! calculate the transformation matrix H(ELENA) -> F(lux)        
                call writo('Calculate T_HF')
                do id = 0,max_deriv
                    ierr = calc_t_hf(grid_eq,eq_1,eq_2,derivs(id))
                    chckerr('')
                end do
                
                ! set up plus minus one
                pmone = 1
                
                ! possibly deallocate
                if (dealloc_vars_loc) then
                    deallocate(eq_2%h_E)
                end if
        end select
        
#if ldebug
        if (ltest) then
            call writo('Test calculation of T_EF?')
            if(get_log(.false.)) then
                ierr = test_t_ef(grid_eq,eq_1,eq_2)
                chckerr('')
                call pause_prog
            end if
        end if
#endif
        
        ! calculate  the  inverse of  the transformation  matrix T_EF
        call writo('Calculate T_FE')
        do id = 0,max_deriv
            ierr = calc_inv_met(eq_2%T_FE,eq_2%T_EF,derivs(id))
            chckerr('')
            ierr = calc_inv_met(eq_2%det_T_FE,eq_2%det_T_EF,derivs(id))
            chckerr('')
        end do
        
        ! calculate the metric factors in the Flux coordinate system
        call writo('Calculate g_F')
        do id = 0,max_deriv
            ierr = calc_g_f(eq_2,derivs(id))
            chckerr('')
        end do
        
        ! calculate the inverse h_F of the metric factors g_F
        call writo('Calculate h_F')
        do id = 0,max_deriv
            ierr = calc_inv_met(eq_2%h_F,eq_2%g_F,derivs(id))
            chckerr('')
        end do
        
        ! calculate the jacobian in the Flux coordinate system
        call writo('Calculate jac_F')
        do id = 0,max_deriv
            ierr = calc_jac_f(eq_2,derivs(id))
            chckerr('')
        end do
        
        ! limit Jacobians to small value to avoid infinities
        eq_2%jac_F(:,:,:,0,0,0) = sign(&
            &max(tol_zero,abs(eq_2%jac_F(:,:,:,0,0,0))),eq_2%jac_F(:,:,:,0,0,0))
        eq_2%jac_E(:,:,:,0,0,0) = sign(&
            &max(tol_zero,abs(eq_2%jac_E(:,:,:,0,0,0))),eq_2%jac_E(:,:,:,0,0,0))
        
        ! possibly deallocate
        if (dealloc_vars_loc) then
            deallocate(eq_2%g_E)
        end if
        
        ! Transform metric equilibrium E into F derivatives
        ierr = calc_f_derivs(eq_2)
        chckerr('')
        
        ! possibly deallocate
        if (dealloc_vars_loc) then
            deallocate(eq_2%g_F,eq_2%h_F,eq_2%jac_F)
            deallocate(eq_2%det_T_EF,eq_2%det_T_FE)
        end if
        
        ! Calculate derived metric quantities
        ierr = calc_derived_q(grid_eq,eq_1,eq_2)
        chckerr('')
        
#if ldebug
        if (ltest) then
            call writo('Test Jacobian in Flux coordinates?')
            if(get_log(.false.)) then
                ierr = test_jac_f(grid_eq,eq_1,eq_2)
                chckerr('')
                call pause_prog
            end if
            call writo('Test calculation of B_F?')
            if(get_log(.false.)) then
                ierr = test_b_f(grid_eq,eq_1,eq_2)
                chckerr('')
                call pause_prog
            end if
            call writo('Test consistency with given pressure?')
            if(get_log(.false.)) then
                ierr = test_p(grid_eq,eq_1,eq_2)
                chckerr('')
                call pause_prog
            end if
        end if
#endif
        
        call lvl_ud(-1)
        
        call writo('Done setting up metric equilibrium quantities')
    end function calc_eq_2
    
    integer function create_vmec_input(grid_eq,eq_1) result(ierr)
        use eq_vars, only: pres_0, r_0, psi_0, b_0, vac_perm
        !use eq_vars, only: max_flux_E
        use grid_vars, only: n_r_eq
        use grid_utilities, only: nufft, calc_xyz_grid
        use helena_vars, only: nchi, r_h, z_h, ias, rbphi_h, flux_p_h, &
            &flux_t_h, chi_h, rmtog_h, bmtog_h
        use x_vars, only: min_r_sol, max_r_sol
        use input_utilities, only: pause_prog, get_log, get_int, get_real
        use num_utilities, only: gcd, bubble_sort, order_per_fun, &
            &shift_f, calc_int, spline
        use num_vars, only: eq_name, hel_pert_i, hel_export_i, &
            &norm_disc_prec_eq, prop_b_tor_i, tol_zero, mu_0_original, &
            &use_normalization
        use files_utilities, only: skip_comment, count_lines
        use ezspline_obj
        use ezspline
#if ldebug
        use num_vars, only: ltest
#endif
        
        character(*), parameter :: rout_name = 'create_VMEC_input'
        
        ! input / output
        type(grid_type), intent(in) :: grid_eq
        type(eq_1_type), intent(in) :: eq_1
        
        ! local variables
        type(ezspline2_r8) :: f_spl                                             ! spline object for interpolation
        integer :: id, jd, kd, ld                                               ! counters
        integer :: n_b                                                          ! nr. of points in Fourier series
        integer :: nfp                                                          ! scale factor for toroidal mode numbers
        integer :: tot_nr_pert                                                  ! total number of perturbations combinations (N,M)
        integer :: nr_n                                                         ! number of different N in perturbation
        integer :: id_n_0                                                       ! index where zero N is situated in B_F
        integer :: n_loc, m_loc                                                 ! local n and m of perturbation
        integer :: pert_map_n_loc                                               ! n_loc for perturbation map
        integer :: n_id                                                         ! index in bundled n_pert
        integer :: n_pert_map(2)                                                ! number of points in perturbation map
        integer :: plot_dim(2)                                                  ! plot dimensions
        integer :: rec_min_m                                                    ! recommended minimum of poloidal modes
        integer :: pert_style                                                   ! style of perturbation (1: r, 2: B_tor)
        integer :: pert_type                                                    ! type of perturbation prescription
        integer :: max_n_b_output                                               ! max. nr. of modes written in output file (constant in VMEC)
        integer :: n_prop_b_tor                                                 ! n of angular poins in prop_B_tor
        integer :: nr_m_max                                                     ! maximum nr. of poloidal mode numbers
        integer :: ncurr                                                        ! ncurr VMEC flag (0: prescribe iota, 1: prescribe tor. current)
        integer :: bcs(2,2)                                                     ! boundary conditions
        integer :: m_range(2)                                                   ! range in poloidal modes
        integer, allocatable :: n_pert(:)                                       ! tor. mode numbers and pol. mode numbers for each of them
        integer, allocatable :: n_pert_copy(:)                                  ! copy of n_pert, for sorting
        integer, allocatable :: piv(:)                                          ! pivots for sorting
        character(len=1) :: pm(3)                                               ! "+ " or "-"
        character(len=8) :: flux_name(2)                                        ! "poloidal" or "toroidal"
        character(len=6) :: path_prefix = '../../'                              ! prefix of path
        character(len=max_str_ln) :: hel_pert_file_name                         ! name of perturbation file
        character(len=max_str_ln) :: err_msg                                    ! error message
        character(len=max_str_ln) :: file_name                                  ! name of file
        character(len=max_str_ln) :: plot_name(2)                               ! name of plot file
        character(len=max_str_ln) :: plot_title(2)                              ! name of plot
        character(len=max_str_ln) :: prop_b_tor_file_name                       ! name of B_tor proportionality file
        real(dp) :: eq_vert_shift                                               ! vertical shift in equilibrium
        real(dp) :: pert_map_vert_shift                                         ! vertical shift in perturbation map
        real(dp) :: max_pert_on_axis                                            ! maximum perturbation on axis (theta = 0)
        real(dp) :: m_tol = 1.e-7_dp                                            ! tolerance for Fourier mode strength
        real(dp) :: delta_loc(2)                                                ! local delta
        real(dp) :: plot_lims(2,2)                                              ! limits of plot dims [pi]
        real(dp) :: norm_b_h                                                    ! normalization for R and Z Fourier modes
        real(dp) :: mult_fac                                                    ! global multiplication factor
        real(dp) :: prop_b_tor_smooth                                           ! smoothing of prop_B_tor_interp via Fourier transform
        real(dp) :: rz_b_0(2)                                                   ! origin of R and Z of boundary
        real(dp) :: s_vj(99)                                                    ! normal coordinate s for writing
        real(dp) :: pres_vj(99,0:1)                                             ! pressure for writing
        real(dp) :: rot_t_v(99)                                                 ! rotational transform for writing
        real(dp) :: f_vj(99)                                                    ! F for writing
        real(dp) :: ffp_vj(99)                                                  ! FF' for writing
        real(dp) :: flux_j(99)                                                  ! normalized flux for writing
        real(dp) :: q_saf_vj(99)                                                ! q_saf for writing
        real(dp) :: i_tor_v(99)                                                 ! enclosed toroidal current for VMEC
        real(dp) :: i_tor_j(99)                                                 ! enclosed toroidal current for JOREK
        real(dp) :: norm_j(3)                                                   ! normalization factors for Jorek (R_geo, Z_geo, F0)
        real(dp), allocatable :: psi_t(:)                                       ! normalized toroidal flux
        real(dp), allocatable :: ffp(:)                                         ! FF' in total grid
        real(dp), allocatable :: i_tor(:)                                       ! toroidal current within flux surfaces
        real(dp), allocatable :: norm_transf(:,:)                               ! transformation of normal coordinates between MISHKA and VMEC or JOREK
        real(dp), allocatable :: i_tor_int(:)                                   ! integrated I_tor
        real(dp), allocatable :: rrint(:)                                       ! R^2 integrated poloidally
        real(dp), allocatable :: rrint_loc(:)                                   ! local RRint
        real(dp), allocatable :: r_plot(:,:,:)                                  ! R for plotting of ripple map
        real(dp), allocatable :: z_plot(:,:,:)                                  ! Z for plotting of ripple map
        real(dp), allocatable :: pert_map_r(:)                                  ! R of perturbation map
        real(dp), allocatable :: pert_map_z(:)                                  ! Z of perturbation map
        real(dp), allocatable :: pert_map(:,:)                                  ! perturbation map
        real(dp), allocatable :: pert_map_interp(:)                             ! interpolated perturbation from map
        real(dp), allocatable :: pert_map_interp_f(:,:)                         ! Fourier coefficients of pert_map_interp
        real(dp), allocatable :: r_h_loc(:,:)                                   ! local R_H
        real(dp), allocatable :: z_h_loc(:,:)                                   ! local Z_H
        real(dp), allocatable :: delta(:,:,:)                                   ! amplitudes of perturbations (N,M,c/s)
        real(dp), allocatable :: delta_copy(:,:,:)                              ! copy of delta, for sorting
        real(dp), allocatable :: bh_0(:,:)                                      ! R and Z at unperturbed bounday
        real(dp), allocatable :: b_f(:,:,:,:)                                   ! cos and sin Fourier components
        real(dp), allocatable :: b_f_copy(:,:,:,:)                              ! copy of B_F
        real(dp), allocatable :: b_f_dum(:,:)                                   ! dummy B_F
        real(dp), allocatable :: b_f_dum2(:,:)                                  ! other dummy B_F
        real(dp), allocatable :: b_f_dum3(:,:)                                  ! other dummy B_F
        real(dp), allocatable :: theta_b(:)                                     ! geometric pol. angle
        real(dp), allocatable :: theta_geo(:,:,:)                               ! geometric pol. angle, for plotting
        real(dp), allocatable :: prop_b_tor(:,:)                                ! proportionality between delta B_tor and delta_norm
        real(dp), allocatable :: prop_b_tor_ord(:,:)                            ! ordered prop_B_tor
        real(dp), allocatable :: prop_b_tor_interp(:)                           ! proportionality between delta B_tor and delta_norm
        real(dp), allocatable :: prop_b_tor_interp_f(:,:)                       ! Fourier modes of prop_B_tor_interp
        real(dp), allocatable :: xyz_plot(:,:,:,:)                              ! plotting X, Y and Z
        logical :: zero_n_pert                                                  ! there is a perturbation with N = 0
        logical :: pert_eq                                                      ! whether equilibrium is perturbed
        logical :: stel_sym                                                     ! whether there is stellarator symmetry
        logical :: change_max_n_b_output                                        ! whether to change max_n_B_output
        logical :: found                                                        ! whether something was found
#if ldebug
        real(dp), allocatable :: bh_0_alt(:,:)                                  ! reconstructed R and Z
#endif
        
        ! initialize ierr
        ierr = 0
        
        ! test if full range
        if (min_r_sol.gt.0 .or. max_r_sol.lt.1) then
            ierr = 1
            err_msg = 'This routine should be run with the full normal &
                &range!'
            chckerr(err_msg)
        end if
        
        ! test if normalization constants chosen
        if (.not.all(br_normalization_provided,1)) &
            &call writo('No normalization factors were provided. &
            &Are you sure this is correct?',warning=.true.)
        
        ! set up local R_H and Z_H
        allocate(r_h_loc(nchi,n_r_eq))
        allocate(z_h_loc(nchi,n_r_eq))
        r_h_loc = r_h
        z_h_loc = z_h
        if (use_normalization) then
            r_h_loc = r_h*r_0
            z_h_loc = z_h*r_0
        end if
        
        ! ask for vertical shift
        ! Note: HELENA automatically shifts it zo Zvac = 0
        call writo('Was the equilibrium shifted vertically?')
        eq_vert_shift = 0._dp
        if (get_log(.false.)) then
            call writo('How much higher [m] should the &
                &equilibrium be in the real world?')
            eq_vert_shift = get_real()
            call writo('The equilibrium will be shifted by '//&
                &trim(r2strt(eq_vert_shift))//'m to compensate for this')
            z_h_loc = z_h_loc + eq_vert_shift
        end if
        
        ! set up F, FF' and <R^2>
        allocate(ffp(n_r_eq))
        allocate(rrint(n_r_eq))
        allocate(rrint_loc(nchi))                                               ! includes overlap, as necessary for integration
        ierr = spline(flux_p_h(:,0)/(2*pi),rbphi_h(:,0)**2*0.5_dp,&
            &flux_p_h(:,0)/(2*pi),ffp,ord=norm_disc_prec_eq,deriv=1)
        chckerr('')
        do kd = 1,n_r_eq
            ierr = calc_int(r_h(:,kd)**2,chi_h,rrint_loc)
            chckerr('')
            rrint(kd) = rrint_loc(nchi)
        end do
        if (ias.eq.0) rrint = 2*rrint
        
        ! set up toroidal current:
        ! This is the  toroidal current between neighbouring  flux surfaces (see
        ! first commentary in VMEC2013/Sources/General/add_fluxes.f90:
        !   <J^zeta J>  = - [2pi FF'/mu_0 <J/R^2> + p'<J>]
        !               = - [2pi F'q/mu_0 + p' <R^2>q/F] ,
        ! which all  have units  1/m. Here, <.>  means integration  in a
        ! full poloidal period.
        ! As VMEC  wants the toroidal current  within two infintesimally
        ! separated  flux  surface as  a  function  of the  VMEC  normal
        ! coordinate, above has to be multiplied by
        !   dpsi_PB3D/dpsi_V = psi_tor(edge)/(2pi q)
        ! Finally, there is  an extra factor -1 because  the toroidal coordinate
        ! in VMEC is oposite.
        ! For JOREK,  the same  is done  with the poloidal  flux instead  of the
        ! toroidal and without the change of sign.
        allocate(i_tor(n_r_eq))
        allocate(norm_transf(n_r_eq,2))
        norm_transf(:,1) = -flux_t_h(n_r_eq,0)/(2*pi*eq_1%q_saf_E(:,0))
        norm_transf(:,2) = flux_p_h(n_r_eq,0)/(2*pi)
        i_tor = - (eq_1%pres_E(:,1)*rrint*eq_1%q_saf_E(:,0)/rbphi_h(:,0) + &
            &2*pi*ffp*eq_1%q_saf_E(:,0)/(rbphi_h(:,0)*vac_perm))
        
        ! calculate total toroidal current
        allocate(i_tor_int(size(i_tor)))
        ierr = calc_int(i_tor*norm_transf(:,1),&
            &flux_t_h(:,0)/flux_t_h(n_r_eq,0),i_tor_int)
        if (use_normalization) i_tor_int = i_tor_int * r_0*b_0/mu_0_original
        chckerr('')
        
        ! user output
        call writo('Initialize boundary')
        call lvl_ud(1)
        
        ! full 0..2pi boundary
        if (ias.eq.0) then                                                      ! symmetric (so nchi is odd)
            n_b = nchi*2-2                                                      ! -2 because of overlapping points at 0, pi
        else                                                                    ! asymmetric (so nchi is aumented by one)
            n_b  = nchi-1                                                       ! -1 because of overlapping points at 0
        end if
        allocate(bh_0(n_b,2))                                                   ! HELENA coords (no overlap at 0)
        allocate(theta_b(n_b))                                                  ! geometrical poloidal angle at boundary (overlap at 0)
        if (ias.eq.0) then                                                      ! symmetric
            bh_0(1:nchi,1) = r_h_loc(:,n_r_eq)
            bh_0(1:nchi,2) = z_h_loc(:,n_r_eq)
            do id = 1,nchi-2
                bh_0(nchi+id,1) = r_h_loc(nchi-id,n_r_eq)
                bh_0(nchi+id,2) = -z_h_loc(nchi-id,n_r_eq)
            end do
        else
            bh_0(:,1) = r_h_loc(1:n_b,n_r_eq)
            bh_0(:,2) = z_h_loc(1:n_b,n_r_eq)
        end if
        rz_b_0(1) = sum(r_h_loc(:,1))/size(r_h_loc,1)
        rz_b_0(2) = sum(z_h_loc(:,1))/size(z_h_loc,1)
        theta_b = atan2(bh_0(:,2)-rz_b_0(2),bh_0(:,1)-rz_b_0(1))
        where (theta_b.lt.0) theta_b = theta_b + 2*pi
        call writo('Magnetic axis used for geometrical coordinates:')
        call lvl_ud(1)
        call writo('('//trim(r2str(rz_b_0(1)))//'m, '//&
            &trim(r2str(rz_b_0(2)))//'m)')
        call lvl_ud(-1)
        
#if ldebug
        if (ltest) then
            call writo('Test with circular tokamak?')
            call lvl_ud(1)
            if(get_log(.false.)) then
                call writo('Testing with circular tokamak:')
                call lvl_ud(1)
                call writo('R = 3/2 + 1/2 cos(θ)')
                call writo('Z =       1/2 sin(θ)')
                call writo('with θ equidistant')
                call lvl_ud(-1)
                theta_b = [((id-1._dp)/n_b*2*pi,id=1,n_b)]
                bh_0(:,1) = 1.5_dp + 0.5*cos(theta_b)
                bh_0(:,2) = 0.5*sin(theta_b)
            end if
            call lvl_ud(-1)
        end if
#endif
        
        ! plot with HDF5
        allocate(theta_geo(grid_eq%n(1),1,grid_eq%loc_n_r))
        do kd = 1,grid_eq%loc_n_r
            theta_geo(:,1,kd) = atan2(z_h_loc(:,kd)-rz_b_0(2),&
                &r_h_loc(:,kd)-rz_b_0(1))
        end do
        where (theta_geo.lt.0._dp) theta_geo = theta_geo + 2*pi
        allocate(xyz_plot(grid_eq%n(1),1,grid_eq%loc_n_r,3))
        ierr = calc_xyz_grid(grid_eq,grid_eq,xyz_plot(:,:,:,1),&
            &xyz_plot(:,:,:,2),xyz_plot(:,:,:,3))
        chckerr('')
        call plot_hdf5('theta_geo','theta_geo',theta_geo,&
            &tot_dim=[grid_eq%n(1),1,grid_eq%n(3),3],&
            &loc_offset=[0,0,grid_eq%i_min-1,0],&
            &x=xyz_plot(:,:,:,1),y=xyz_plot(:,:,:,2),z=xyz_plot(:,:,:,3),&
            &descr='geometric poloidal angle used to create the VMEC &
            &input file')
        deallocate(xyz_plot)
        
        ! plot R and Z
        plot_name(1) = 'RZ'
        plot_title = ['R_H','Z_H']
        call print_ex_2d(plot_title(1:2),plot_name(1),bh_0,&
            &x=reshape(theta_b,[n_b,1])/pi,&
            &draw=.false.)
        call draw_ex(plot_title(1:2),plot_name(1),2,1,.false.)
        
        ! set up auxiliary variable
        flux_name = ['poloidal','toroidal']
        
        call lvl_ud(-1)
        
        ! plot properties
        plot_dim = [100,20]
        plot_lims(:,1) = [0.0_dp,2.0_dp]
        plot_lims(:,2) = [0.5_dp,2.0_dp]
        call writo('Change plot properties from defaults?')
        call lvl_ud(1)
        do id = 1,2
            call writo(trim(i2str(plot_dim(id)))//' geometrical '//&
                &flux_name(id)//' points on range '//&
                &trim(r2strt(plot_lims(1,id)))//' pi .. '//&
                &trim(r2strt(plot_lims(2,id)))//' pi')
        end do
        call lvl_ud(-1)
        if (get_log(.false.)) then
            call lvl_ud(1)
            do id = 1,2
                call writo('number of '//flux_name(id)//' points?')
                plot_dim(id) = get_int(lim_lo=2)
                call writo('lower limit of '//flux_name(id)//&
                    &' range [pi]?')
                plot_lims(1,id) = get_real()
                call writo('upper limit of '//flux_name(id)//&
                    &' range [pi]?')
                plot_lims(2,id) = get_real()
            end do
            call lvl_ud(-1)
        end if
        
        ! get ncurr
        call writo('VMEC current style?')
        call lvl_ud(1)
        call writo('0: prescribe iota')
        call writo('1: prescribe toroidal current')
        ncurr = get_int(lim_lo=0,lim_hi=1)
        call lvl_ud(-1)
        
        ! get input about equilibrium perturbation
        ! Note: negative  M values will  be converted  to negative N  values and
        ! Possibly negative delta's at the end.
        call writo('Do you want to perturb the equilibrium?')
        pert_eq = get_log(.false.)
        
        zero_n_pert = .false.
        if (pert_eq) then
            ! get perturbation style
            call writo('Which perturbation do you want to describe?')
            call lvl_ud(1)
            call writo('1: plasma boundary position')
            call writo('2: B_tor magnetic ripple with fixed N')
            call lvl_ud(-1)
            pert_style = get_int(lim_lo=1,lim_hi=2)
            
            ! for style 2, get proportionality file
            if (pert_style.eq.2) then
                ! find file
                found = .false.
                do while (.not.found)
                    call writo('Proportionality file name?')
                    call lvl_ud(1)
                    read(*,*,iostat=ierr) prop_b_tor_file_name
                    err_msg = 'failed to read prop_B_tor_file_name'
                    chckerr(err_msg)
                    
                    ! open
                    do kd = 0,2
                        call writo('Trying "'//path_prefix(1:kd*3)//&
                            &trim(prop_b_tor_file_name)//'"')
                        open(prop_b_tor_i,file=path_prefix(1:kd*3)//&
                            &trim(prop_b_tor_file_name),iostat=ierr,&
                            &status='old')
                        if (ierr.eq.0) then
                            call lvl_ud(1)
                            call writo("Success")
                            call lvl_ud(-1)
                            exit
                        end if
                    end do
                    if (ierr.eq.0) then
                        found = .true.
                    else
                        call writo('Could not open file "'//&
                            &trim(prop_b_tor_file_name)//'"')
                    end if
                    
                    call lvl_ud(-1)
                end do
                
                ! read file
                call writo('Analyzing perturbation proportionality file "'&
                    &//trim(prop_b_tor_file_name)//'"')
                call lvl_ud(1)
                n_prop_b_tor = count_lines(prop_b_tor_i)
                allocate(prop_b_tor(n_prop_b_tor,2))
                ierr = skip_comment(prop_b_tor_i,&
                    &file_name=prop_b_tor_file_name)
                chckerr('')
                do id = 1,n_prop_b_tor
                    read(prop_b_tor_i,*,iostat=ierr) prop_b_tor(id,:)
                end do
                
                ! user info
                call writo(trim(i2str(n_prop_b_tor))//&
                    &' poloidal points '//&
                    &trim(r2strt(minval(prop_b_tor(:,1))))//'..'//&
                    &trim(r2strt(maxval(prop_b_tor(:,1)))))
                call writo('The proportionality factor should be tabulated &
                    &in a geometrical angle that has the SAME origin as &
                    &the one used here',alert=.true.)
                
                ! interpolate the proportionality  factor on the geometrical
                ! poloidal angle used  here (as opposed to the  one in which
                ! it was tabulated)
                ierr = order_per_fun(prop_b_tor,prop_b_tor_ord,1,&              ! overlap of 1 is enough for splines
                    &tol=0.5_dp*pi/n_prop_b_tor)                                ! set appropriate tolerance: a quarter of a equidistant grid
                chckerr('')
                deallocate(prop_b_tor)
                allocate(prop_b_tor_interp(n_b))
                ierr = spline(prop_b_tor_ord(:,1),prop_b_tor_ord(:,2),&
                    &theta_b,prop_b_tor_interp,ord=norm_disc_prec_eq,&
                    &bcs=[-1,-1])
                chckerr('')
                deallocate(prop_b_tor_ord)
                if (grid_eq%n(2).ne.1) call writo('There should be only 1 &
                    &geodesical position, but there are '//&
                    &trim(i2str(grid_eq%n(2))),warning=.true.)
                
                ! smooth prop_B_tor_interp
                prop_b_tor_smooth = 1._dp
                call writo('Do you want to smooth the perturbation?')
                if (get_log(.false.)) prop_b_tor_smooth = &
                    &get_real(lim_lo=0._dp,lim_hi=1._dp)
                
                ! calculate NUFFT
                ierr = nufft(theta_b,prop_b_tor_interp,prop_b_tor_interp_f)
                chckerr('')
                deallocate(prop_b_tor_interp)
                
                call lvl_ud(-1)
            end if
            
            ! get perturbation type
            call writo('How do you want to prescribe the perturbation?')
            call lvl_ud(1)
            call writo('1: through a file with Fourier modes in &
                &geometrical coordinates')
            call lvl_ud(1)
            call writo('It should provide N M delta_cos delta_sin in four &
                &columns')
            call writo('Rows starting with "#" are ignored')
            call lvl_ud(-1)
            call writo('2: same as 1 but interactively')
            call writo('3: through a 2-D map in R, Z for constant &
                &geometrical coordinates')
            call lvl_ud(1)
            call writo('It should provide R, Z and delta')
            call writo('Rows starting with "#" are ignored')
            call lvl_ud(-1)
            pert_type = get_int(lim_lo=1,lim_hi=3)
            call lvl_ud(-1)
            
            select case (pert_type)
                case (1,3)                                                      ! files
                    found = .false.
                    do while (.not.found)
                        ! user input
                        call writo('File name?')
                        call lvl_ud(1)
                        read(*,*,iostat=ierr) hel_pert_file_name
                        err_msg = 'failed to read HEL_pert_file_name'
                        chckerr(err_msg)
                        
                        ! open
                        do kd = 0,2
                            call writo('Trying "'//path_prefix(1:kd*3)//&
                                &trim(hel_pert_file_name)//'"')
                            open(hel_pert_i,file=path_prefix(1:kd*3)//&
                                &trim(hel_pert_file_name),iostat=ierr,&
                                &status='old')
                            if (ierr.eq.0) then
                                call lvl_ud(1)
                                call writo("Success")
                                call lvl_ud(-1)
                                exit
                            end if
                        end do
                        if (ierr.eq.0) then
                            found = .true.
                        else
                            call writo('Could not open file "'//&
                                &trim(hel_pert_file_name)//'"')
                        end if
                        
                        call lvl_ud(-1)
                    end do
                    
                    call writo('Parsing "'//trim(hel_pert_file_name)//'"')
                    call lvl_ud(1)
                    
                    if (pert_type.eq.1) then                                    ! Fourier modes in geometrical coordinates
                        ! get number of lines
                        tot_nr_pert = count_lines(hel_pert_i)
                    else if (pert_type.eq.3) then                               ! 2-D map of perturbation
                        ! ask for vertical shift
                        call writo('Was the equilibrium shifted &
                            &vertically?')
                        if (abs(eq_vert_shift).gt.0._dp) then
                            call lvl_ud(1)
                            call writo('Note: If you already shifted just &
                                &now, don''t do it again!',alert=.true.)
                            call lvl_ud(-1)
                        end if
                        pert_map_vert_shift = 0._dp
                        if (get_log(.false.)) then
                            call writo('How much higher [m] should the &
                                &equilibrium be in the real world?')
                            pert_map_vert_shift = get_real()
                            call writo('The perturbation map will be &
                                &shifted by '//&
                                &trim(r2strt(-pert_map_vert_shift))//&
                                &'m to compensate for this')
                        end if
                        
                        ! get map
                        ierr = skip_comment(hel_pert_i,&
                            &file_name=hel_pert_file_name)
                        chckerr('')
                        read(hel_pert_i,*) n_pert_map(1)                        ! nr. of points in R
                        allocate(pert_map_r(n_pert_map(1)))
                        do kd = 1,n_pert_map(1)
                            read(hel_pert_i,*) pert_map_r(kd)
                        end do
                        ierr = skip_comment(hel_pert_i,&
                            &file_name=hel_pert_file_name)
                        chckerr('')
                        read(hel_pert_i,*) n_pert_map(2)                        ! nr. of points in R
                        allocate(pert_map_z(n_pert_map(2)))
                        do kd = 1,n_pert_map(2)
                            read(hel_pert_i,*) pert_map_z(kd)
                        end do
                        pert_map_z = pert_map_z - pert_map_vert_shift
                        ierr = skip_comment(hel_pert_i,&
                            &file_name=hel_pert_file_name)
                        chckerr('')
                        allocate(pert_map(n_pert_map(1),n_pert_map(2)))
                        do kd = 1,n_pert_map(1)
                            read(hel_pert_i,*) pert_map(kd,:)
                        end do
                        
                        ! plot map
                        allocate(r_plot(n_pert_map(1),n_pert_map(2),1))
                        allocate(z_plot(n_pert_map(1),n_pert_map(2),1))
                        do kd = 1,n_pert_map(2)
                            r_plot(:,kd,1) = pert_map_r
                        end do
                        do kd = 1,n_pert_map(1)
                            z_plot(kd,:,1) = pert_map_z
                        end do
                        call plot_hdf5('pert_map','pert_map',&
                            &reshape(pert_map,[n_pert_map,1]),&
                            &x=r_plot,y=z_plot,descr=&
                            &'perturbation map for '//&
                            &trim(hel_pert_file_name))
                        deallocate(r_plot,z_plot)
                        
                        ! test
                        if (minval(r_h_loc).lt.minval(pert_map_r) .or. &
                            &maxval(r_h_loc).gt.maxval(pert_map_r) .or. &
                            &minval(z_h_loc).lt.minval(pert_map_z) .or. &
                            &maxval(z_h_loc).gt.maxval(pert_map_z)) then
                            ierr = 1
                            call writo('Are you sure you have specified &
                                &a normalization factor R_0?',alert=.true.)
                            err_msg = 'R and Z are not contained in &
                                &perturbation map'
                            chckerr(err_msg)
                        end if
                        
                        ! set up 2-D spline
                        allocate(pert_map_interp(n_b))
                        bcs(:,1) = [0,0]                                        ! not a knot
                        bcs(:,2) = [0,0]                                        ! not a knot
                        call ezspline_init(f_spl,n_pert_map(1),n_pert_map(2),&
                            &bcs(:,1),bcs(:,2),ierr)
                        call ezspline_error(ierr)
                        chckerr('')
                        
                        ! set grid
                        f_spl%x1 = pert_map_r
                        f_spl%x2 = pert_map_z
                        
                        ! set up 
                        call ezspline_setup(f_spl,pert_map,ierr,&
                            &exact_dim=.true.)                                  ! match exact dimensions, none of them old Fortran bullsh*t!
                        call ezspline_error(ierr)
                        chckerr('')
                        
                        ! interpolate
                        do id = 1,n_b
                            call ezspline_interp(f_spl,bh_0(id,1),bh_0(id,2),&
                                &pert_map_interp(id),ierr)
                            call ezspline_error(ierr)
                            chckerr('')
                        end do
                        call print_ex_2d('ripple','pert_map_interp',&
                            &pert_map_interp,x=theta_b,draw=.false.)
                        call draw_ex(['ripple'],'pert_map_interp',&
                            &1,1,.false.)
                        
                        ! calculate NUFFT
                        ierr = nufft(theta_b,pert_map_interp,&
                            &pert_map_interp_f)
                        chckerr('')
                        tot_nr_pert = size(pert_map_interp_f,1)*2               ! need both positive and negative n
                        
                        ! get toroidal mode number
                        call writo('toiroidal period for 2-D map?')
                        pert_map_n_loc = get_int(lim_lo=0)
                    end if
                    
                    call lvl_ud(-1)
                case (2)                                                        ! interactively
                    ! user input
                    call writo('Prescribe interactively')
                    call writo('How many different combinations of &
                        &toroidal and poloidal mode numbers (N,M)?')
                    tot_nr_pert = get_int(lim_lo=1)
            end select
            
            ! set up n, m and delta
            allocate(n_pert(tot_nr_pert+1))
            allocate(delta(tot_nr_pert+1,0:0,2))                                ! start with only M = 0
            delta = 0._dp
            nr_n = 0
            do jd = 1,tot_nr_pert
                select case (pert_type)
                    case (1)                                                    ! file with Fourier modes in geometrical coordinates
                        ierr = skip_comment(hel_pert_i,&
                            &file_name=hel_pert_file_name)
                        chckerr('')
                        read(hel_pert_i,*,iostat=ierr) n_loc, m_loc, &
                            &delta_loc
                        err_msg = 'Could not read file '//&
                            &trim(hel_pert_file_name)
                        chckerr(err_msg)
                    case (2)                                                    ! same as 1 but interactively
                        call writo('For mode '//trim(i2str(jd))//'/'//&
                            &trim(i2str(tot_nr_pert))//':')
                        call lvl_ud(1)
                        
                        ! input
                        call writo('Toroidal mode number N?')
                        n_loc = get_int()
                        call writo('Poloidal mode number M?')
                        m_loc = get_int()
                        call writo('Perturbation strength ~ cos('//&
                            &trim(i2str(m_loc))//' θ - '//&
                            &trim(i2str(n_loc))//' ζ)?')
                        delta_loc(1) = get_real()
                        call writo('Perturbation strength ~ sin('//&
                            &trim(i2str(m_loc))//' θ - '//&
                            &trim(i2str(n_loc))//' ζ)?')
                        delta_loc(2) = get_real()
                        
                        call lvl_ud(-1)
                    case (3)                                                    ! file with Fourier modes in general coordinates
                        m_loc = (jd-1)/2                                        ! so the output is 0,0,1,1,2,2,3,3,4,4,...
                        delta_loc = pert_map_interp_f(m_loc+1,:)*0.5_dp         ! both + and - helicity, so need to divide amplitude by 2
                        n_loc = pert_map_n_loc
                        if (mod(jd,2).eq.0) n_loc = -n_loc
                end select
                
                ! has N = 0 been prescribed?
                if (n_loc.eq.0) zero_n_pert = .true.
                
                ! bundle into n_pert
                n_id = nr_n+1                                                   ! default new N in next index
                do id = 1,nr_n
                    if (n_loc.eq.n_pert(id)) n_id = id
                end do
                if (n_id.gt.nr_n) then                                          ! new N
                    nr_n = n_id                                                 ! increment number of N
                    n_pert(n_id) = n_loc                                        ! with value n_loc
                end if
                m_range = [lbound(delta,2),ubound(delta,2)]
                if (m_loc.gt.m_range(1) .or. m_loc.lt.m_range(2)) then          ! enlarge delta
                    allocate(delta_copy(tot_nr_pert+1,&
                        &m_range(1):m_range(2),2))
                    delta_copy = delta
                    deallocate(delta)
                    allocate(delta(tot_nr_pert+1,&
                        &min(m_range(1),m_loc):max(m_range(2),m_loc),2))
                    delta = 0._dp
                    delta(:,m_range(1):m_range(2),:) = delta_copy
                    deallocate(delta_copy)
                end if
                delta(n_id,m_loc,:) = delta(n_id,m_loc,:) + delta_loc           ! and perturbation amplitude for cos and sin with value delta_loc
                
#if ldebug
                if (debug_create_vmec_input) then
                    call writo('perturbation '//trim(i2str(jd))//&
                        &' at position '//trim(i2str(n_id))//', adding ('//&
                        &trim(r2strt(delta(n_id,m_loc,1)))//', '//&
                        &trim(r2strt(delta(n_id,m_loc,2)))//') at (n,m) = ('//&
                        &trim(i2str(n_loc))//', '//trim(i2str(m_loc))//')')
                    call lvl_ud(1)
                    do kd = lbound(delta,2),ubound(delta,2)
                        call writo('delta ('//trim(i2str(kd))//') = ('//&
                            &trim(r2strt(delta(n_id,kd,1)))//', '//&
                            &trim(r2strt(delta(n_id,kd,2)))//')')
                    end do
                    call lvl_ud(-1)
                end if
#endif
            end do
            
            if (pert_type.eq.1 .or. pert_type.eq.3) close(hel_pert_i)
            
            ! ask for global rescaling
            ! Note: This  is only valid if R(θ=0) is  the place with the    
            ! maximum perturbation
            max_pert_on_axis = sum(sqrt(sum(delta**2,3)))
            select case (pert_style)
                case (1)                                                        ! plasma boundary position
                    call writo('Maximum absolute perturbation on axis: '//&
                        &trim(r2strt(100*max_pert_on_axis))//'cm')
                    call writo('Rescale to some value [cm]?')
                case (2)                                                        ! B_tor magnetic ripple with fixed N
                    call writo('Maximum relative perturbation on axis: '//&
                        &trim(r2strt(100*max_pert_on_axis))//'%')
                    call writo('Rescale to some value [%]?')
            end select
            mult_fac = max_pert_on_axis
            if (get_log(.false.)) then
                mult_fac = get_real()
                mult_fac = mult_fac * 0.01_dp
            end if
            delta = delta * mult_fac / max_pert_on_axis
            
            ! add zero to the peturbations if it's not yet there
            ! (for the bubble sort)
            if (.not.zero_n_pert) then
                nr_n = nr_n+1
                n_pert(nr_n) = 0
            end if
        else
            nr_n = 1
        end if
        
        ! user output
        call writo('Set up axisymmetric data')
        call lvl_ud(1)
        
        ! calculate output for unperturbed R and Z
        nr_m_max = (n_b-1)/2                                                    ! maximum perturbation
        if (pert_eq) then
            nr_m_max = max(nr_m_max, max(-lbound(delta,2),ubound(delta,2)))     ! correct if less than delta
            if (pert_style.eq.2) &
                &nr_m_max = max(nr_m_max, size(prop_b_tor_interp_f,1)-1)        ! correct if less than proportionality map
        end if
        plot_name(1) = 'R_F'
        plot_name(2) = 'Z_F'
        allocate(b_f(nr_n,-nr_m_max:nr_m_max,2,2))                              ! (tor modes, pol modes, cos/sin (m θ), R/Z)
        ! Note: B_F will later be reallocated to run from 0:nr_m_max in index 2
        b_f = 0._dp
        do kd = 1,2
            ! user output
            call writo('analyzing '//trim(plot_name(kd)))
            call lvl_ud(1)
            
            ! NUFFT
            ierr = nufft(theta_b,bh_0(:,kd),b_f_dum,plot_name(kd))
            chckerr('')
            b_f(1,0:size(b_f_dum,1)-1,:,kd) = b_f_dum
        
#if ldebug
            if (debug_create_vmec_input) then
                allocate(bh_0_alt(size(bh_0,1),size(b_f_dum,1)))
                
                call writo('Comparing R or Z with reconstruction &
                    &through Fourier coefficients')
                bh_0_alt(:,1) = b_f_dum(1,1)
                do id = 1,size(b_f_dum,1)-1
                    bh_0_alt(:,id+1) = bh_0_alt(:,id) + &
                        &b_f_dum(id+1,1)*cos(id*theta_b) + &
                        &b_f_dum(id+1,2)*sin(id*theta_b)
                end do
                call print_ex_2d(['orig BH','alt BH '],'',&
                    &reshape([bh_0(:,kd),bh_0_alt(:,size(b_f_dum,1))],&
                    &[size(bh_0,1),2]),x=&
                    &reshape([theta_b],[size(bh_0,1),1]))
                
                call writo('Plotting Fourier approximation')
                call print_ex_2d(['alt BH'],'TEST_'//trim(plot_name(kd))//&
                    &'_F_series',bh_0_alt,&
                    &x=reshape([theta_b],[size(bh_0,1),1]))
                call draw_ex(['alt BH'],'TEST_'//trim(plot_name(kd))//&
                    &'_F_series',size(b_f_dum,1),1,.false.)
                
                call writo('Making animation')
                call print_ex_2d(['alt BH'],'TEST_'//trim(plot_name(kd))//&
                    &'_F_series_anim',bh_0_alt,&
                    &x=reshape([theta_b],[size(bh_0,1),1]))
                call draw_ex(['alt BH'],'TEST_'//trim(plot_name(kd))//&
                    &'_F_series_anim',size(b_f_dum,1),1,.false.,&
                    &is_animated=.true.)
                
                deallocate(bh_0_alt)
            end if
#endif
            deallocate(b_f_dum)
            
            call lvl_ud(-1)
        end do
        
        ! plot axisymetric boundary in 3D
        ! Note: Still using -nr_m_max:nr_m_max for poloidal modes
        call plot_boundary(b_f(1:1,:,:,:),[-nr_m_max,nr_m_max],[0],&
            &'last_fs',plot_dim,plot_lims)
        
        call lvl_ud(-1)
        
        ! sort and output
        if (pert_eq) then
            ! user output
            call writo('Set up perturbed data')
            call lvl_ud(1)
            
            ! sort
            allocate(n_pert_copy(nr_n))
            allocate(delta_copy(nr_n,-nr_m_max:nr_m_max,2))
            delta_copy = 0.0_dp
            n_pert_copy = n_pert(1:nr_n)
            delta_copy(:,lbound(delta,2):ubound(delta,2),:) = delta(1:nr_n,:,:)
            deallocate(n_pert); allocate(n_pert(nr_n)); n_pert = n_pert_copy
            deallocate(delta); allocate(delta(nr_n,-nr_m_max:nr_m_max,2))
            deallocate(n_pert_copy)
            allocate(piv(nr_n))
            call bubble_sort(n_pert,piv)                                        ! sort n
            do jd = 1,nr_n
                delta(jd,:,:) = delta_copy(piv(jd),:,:)
            end do
            deallocate(piv)
            
            ! update the index of N = 0 in B_F
            id_n_0 = minloc(abs(n_pert),1)
            if (id_n_0.gt.1) then
                b_f(id_n_0,:,:,:) = b_f(1,:,:,:)
                b_f(1,:,:,:) = 0._dp
            end if
            
            ! output
            call writo('Summary of perturbation form:')
            call lvl_ud(1)
            do jd = 1,nr_n
                do id = -nr_m_max,nr_m_max
                    if (maxval(abs(delta(jd,id,:))).lt.tol_zero) cycle          ! this mode has no amplitude
                    if (n_pert(jd).ge.0) then
                        pm(1) = '-'
                    else
                        pm(1) = '+'
                    end if
                    if (delta(jd,id,1).ge.0) then
                        pm(2) = '+'
                    else
                        pm(2) = '-'
                    end if
                    if (jd.eq.1 .and. id.eq.1) pm(2) = ''
                    if (delta(jd,id,2).ge.0) then
                        pm(3) = '+'
                    else
                        pm(3) = '-'
                    end if
                    call writo(&
                        &pm(2)//' '//trim(r2strt(abs(delta(jd,id,1))))//&
                        &' cos('//trim(i2str(id))//' θ '//pm(1)//' '//&
                        &trim(i2str(abs(n_pert(jd))))//' ζ) '//&
                        &pm(3)//' '//trim(r2strt(abs(delta(jd,id,2))))//&
                        &' sin('//trim(i2str(id))//' θ '//pm(1)//' '//&
                        &trim(i2str(abs(n_pert(jd))))//' ζ)')
                end do
            end do
            call lvl_ud(-1)
            
            ! loop  over all  toroidal  modes N  and  include the  corresponding
            ! perturbation, consisting of terms of the form:
            ! δc cos(M θ - N ζ) + δs sin(M θ - N ζ) = 
            !   δc [cos(M θ)cos(N ζ) + sin(M θ) sin(N ζ) ] + 
            !   δs [sin(M θ)cos(N ζ) - cos(M θ) sin(N ζ) ].
            ! First, however, the δc and δs have to be translated from
            ! an absolute modification  of the radius r = sqrt(R^2  + Z^2) to an
            ! absolute modification of R and Z:
            !    ΔR = δ(m) cos(m θ)
            !    ΔZ = δ(m) sin(m θ),
            ! which simply shifts up and down the index m by one.
            ! Additionally, for perturbation type 2  (2D map), there is an extra
            ! shift before this.
            !
            ! These shifts are done separately  for each toroidal mode number N,
            ! so that  the factors cos(θ M)  and sin(θ M) are  shifted and the
            ! resulting corresponding modal amplitudes  become δc' and δs' for
            ! the term proportional to cos(N ζ):
            !    δc cos(M θ) + δs sin(M θ),
            ! and δc" and δs" for the term proportional to sin(N ζ):
            !   -δs cos(M θ) + δc sin(M θ).
            !
            ! Finally recombining  the results into terms  proportional to cos(m
            ! θ - N ζ) and sin(m θ - N ζ) then results in
            !   (δc'+δs")/2 cos(m θ - N ζ) + (δc'-δs")/2 cos(-m θ - N ζ) +
            !   (δs'-δc")/2 sin(m θ - N ζ) - (δs'+δc")/2 sin(-m θ - N ζ),
            ! which  means that the  different toroidal  modes N can  be treated
            ! independently.
            !
            ! Note that if  there is no shifting  at all, δc =  δc' =  δs" and
            ! δs = δs' = -δc" and m = M, which indeed reduces to
            !   δc cos(M θ - N ζ) + δs sin(M θ - N ζ).
            m_range = [-nr_m_max,nr_m_max]
            pert_n: do jd = 1,nr_n
                ! initialize
                allocate(b_f_dum(-nr_m_max:nr_m_max,2))
                allocate(b_f_dum2(-nr_m_max:nr_m_max,2))
                allocate(b_f_dum3(-nr_m_max:nr_m_max,2))
                
                ! for R, shift due to cos(θ), for Z, shift due to sin(θ)
                do kd = 1,2                                                     ! iterate over R (kd = 1), then Z (kd = 2)
                    b_f_dum = 0._dp
                    b_f_dum(1,kd) = 1._dp                                       ! cos(θ) for kd = 1, sin(θ) for kd = 2
                    if (pert_style.eq.2) then                                   ! shift due to proportionality map
                        b_f_dum2(0:ubound(prop_b_tor_interp_f,1),:) = &
                            &prop_b_tor_interp_f
                        call shift_f(m_range,m_range,m_range,&
                            &b_f_dum,b_f_dum2,b_f_dum3)
                        b_f_dum = b_f_dum3
                    end if
                    
                    ! calculate δ' due to δc cos(M θ) + δs sin(M θ)
                    b_f_dum2(:,1) = delta(jd,:,1)                               ! ~ cos
                    b_f_dum2(:,2) = delta(jd,:,2)                               ! ~ sin
                    call shift_f(m_range,m_range,m_range,&
                        &b_f_dum,b_f_dum2,b_f_dum3)
                    b_f_dum3 = b_f_dum3*0.5_dp
                    !  (δc'+δs")/2 cos(m θ - N ζ)
                    b_f(jd,:,1,kd) = b_f(jd,:,1,kd) + b_f_dum3(:,1)
                    !  (δs'-δc")/2 sin(m θ - N ζ)
                    b_f(jd,:,2,kd) = b_f(jd,:,2,kd) + b_f_dum3(:,2)
                    !  (δc'-δs")/2 cos(-m θ - N ζ)
                    b_f(jd,:,1,kd) = b_f(jd,:,1,kd) + &
                        &b_f_dum3(nr_m_max:-nr_m_max:-1,1)
                    ! -(δs'+δc")/2 sin(-m θ - N ζ)
                    b_f(jd,:,2,kd) = b_f(jd,:,2,kd) - &
                        &b_f_dum3(nr_m_max:-nr_m_max:-1,2)
                    
                    ! calculate δ' due to -δs cos(M θ) + δc sin(M θ)
                    b_f_dum2(:,1) = -delta(jd,:,2)                              ! ~ cos
                    b_f_dum2(:,2) = delta(jd,:,1)                               ! ~ sin
                    call shift_f(m_range,m_range,m_range,&
                        &b_f_dum,b_f_dum2,b_f_dum3)
                    b_f_dum3 = b_f_dum3*0.5_dp
                    !  (δc'+δs")/2 cos(m θ - N ζ)
                    b_f(jd,:,1,kd) = b_f(jd,:,1,kd) + b_f_dum3(:,2)
                    !  (δs'-δc")/2 sin(m θ - N ζ)
                    b_f(jd,:,2,kd) = b_f(jd,:,2,kd) - b_f_dum3(:,1)
                    !  (δc'-δs")/2 cos(-m θ - N ζ)
                    b_f(jd,:,1,kd) = b_f(jd,:,1,kd) - &
                        &b_f_dum3(nr_m_max:-nr_m_max:-1,2)
                    ! -(δs'+δc")/2 sin(-m θ - N ζ)
                    b_f(jd,:,2,kd) = b_f(jd,:,2,kd) - &
                        &b_f_dum3(nr_m_max:-nr_m_max:-1,1)
                end do
                
                deallocate(b_f_dum)
                deallocate(b_f_dum2)
                deallocate(b_f_dum3)
            end do pert_n
            
            allocate(b_f_copy(2*nr_n,0:nr_m_max,2,2))                           ! swap negative m for inverse n
            allocate(n_pert_copy(2*nr_n))
            b_f_copy = 0._dp
            n_pert_copy = 0
            nr_n = 0                                                            ! start at zero again
            allocate(b_f_dum(0:nr_m_max,2))
            pert_n_convert: do jd = 1,size(b_f,1)
                do kd = 1,2                                                     ! loop over negative and positive ranges
                    ! loop over R and Z
                    do ld = 1,2
                        ! initialize B_F dummy, then set it up
                        b_f_dum = 0._dp
                        if (kd.eq.1) then
                            ! set local n for negative range: invert n and m
                            n_loc = -n_pert(jd)
                            b_f_dum(0:nr_m_max,1) = b_f(jd,0:-nr_m_max:-1,1,ld) ! do not invert cosine factors
                            b_f_dum(0:nr_m_max,2) = -b_f(jd,0:-nr_m_max:-1,2,ld)! invert sine factors
                        else
                            ! set local n for positive range
                            n_loc = n_pert(jd)
                            b_f_dum(0:nr_m_max,:) = b_f(jd,0:nr_m_max,:,ld)
                        end if
                        b_f_dum(0,:) = b_f_dum(0,:)*0.5_dp                      ! positive and negative range share half each
                        
                        if (maxval(abs(b_f_dum)).gt.tol_zero) then
                            ! bundle into n_pert
                            n_id = nr_n+1                                       ! default new N in next index
                            do id = 1,nr_n                                      ! check all previous, though
                                if (n_loc.eq.n_pert_copy(id)) n_id = id
                            end do
                            if (n_id.gt.nr_n) then                              ! new N
                                nr_n = n_id                                     ! increment number of N
                                n_pert_copy(n_id) = n_loc                       ! with value n_loc
                            end if
#if ldebug
                            if (debug_create_vmec_input) then
                                call writo('putting n = '//trim(i2str(n_loc))//&
                                    &' in index '//trim(i2str(n_id))//':')
                                if (kd.eq.1) then
                                    call writo('(negative range)')
                                else
                                    call writo('(positive range)')
                                end if
                                if (ld.eq.1) then
                                    call writo('(for R)')
                                else
                                    call writo('(for Z)')
                                end if
                                call lvl_ud(1)
                                do id = 0,nr_m_max
                                    if (maxval(abs(b_f_dum(id,:)))&
                                        &.gt.tol_zero) then
                                        call writo('B_F ('//trim(i2str(id))//&
                                            &') = ('//&
                                            &trim(r2strt(b_f_dum(id,1)))//&
                                            &', '//&
                                            &trim(r2strt(b_f_dum(id,2)))//')')
                                    end if
                                end do
                                call lvl_ud(-1)
                            end if
#endif
                            
                            ! update B_F_copy
                            b_f_copy(n_id,:,:,ld) = b_f_copy(n_id,:,:,ld) + &
                                &b_f_dum
                        end if
                    end do
                end do
            end do pert_n_convert
            
            ! copy back to B_F and n_pert
            deallocate(b_f)
            deallocate(n_pert)
            allocate(b_f(nr_n,0:nr_m_max,2,2))
            allocate(n_pert(nr_n))
            b_f = b_f_copy(1:nr_n,:,:,:)
            n_pert = n_pert_copy(1:nr_n)
            deallocate(b_f_copy)
            deallocate(n_pert_copy)
            
            ! plot boundary in 3D
            ! Note: Using 0:nr_m_max for poloidal modes
            call plot_boundary(b_f,[0,nr_m_max],n_pert(1:nr_n),'last_fs_pert',&
                &plot_dim,plot_lims)
            call lvl_ud(-1)
            
            ! set nfp: save greatest common denominator of N into nfp, excluding
            ! N=0
            do jd = 2,nr_n
                if (jd.eq.2) then
                    nfp = n_pert(jd)
                else
                    nfp = gcd(nfp,n_pert(jd))
                end if
            end do
            if (nfp.ne.0) then
                n_pert = n_pert/nfp
            else
                nfp = 1
            end if
        else
            ! migrate negative poloidal modes to positive in B_F_copy
            allocate(b_f_copy(1,0:nr_m_max,2,2))                                ! (tor modes, pol modes, cos/sin (m θ), R/Z)
            do id = 0,nr_m_max
                b_f_copy(1,id,1,:) = b_f(1,id,1,:) + b_f(1,-id,1,:)             ! do not invert cosine factors
                b_f_copy(1,id,2,:) = b_f(1,id,2,:) - b_f(1,-id,2,:)             ! invert sine factors
            end do
            b_f_copy(1,0,:,:) = b_f_copy(1,0,:,:)*0.5_dp                        ! positive and negative range share half each
            deallocate(b_f)
            allocate(b_f(1,0:nr_m_max,2,2))
            b_f = b_f_copy
            deallocate(b_f_copy)
            
            ! set the index of N = 0 in B_F
            id_n_0 = 1
            
            ! set nfp to one
            nfp = 1
        end if
        
        ! Note: From now on the dimensions of B_F are (nr_n,0:nr_m_max,2,2)
        
        ! user output
        file_name = "input."//trim(eq_name)
        if (pert_eq) then
            select case (pert_type)
                case (1)                                                        ! Fourier modes in geometrical coordinates
                    file_name = trim(file_name)//'_'//&
                        &trim(hel_pert_file_name)
                case (2)                                                        ! specified manually
                    do jd = 1,nr_n
                        file_name = trim(file_name)//'_N'//&
                            &trim(i2str(n_pert(jd)))
                        do kd = 0,nr_m_max
                            file_name = trim(file_name)//'M'//&
                                &trim(i2str(kd))
                        end do
                    end do
                case (3)                                                        ! 2-D map
                    file_name = trim(file_name)//'_2DMAP'
            end select
        end if
        call writo('Generate VMEC input file "'//trim(file_name)//'"')
        call writo('This can be used for VMEC porting')
        call lvl_ud(1)
        
        ! detect whether there is stellarator symmetry
        stel_sym = .false.
        if (maxval(abs(b_f(:,:,2,1)))/maxval(abs(b_f(:,:,1,1))) &
            &.lt. m_tol .and. &                                                 ! R_s << R_c
            maxval(abs(b_f(:,:,1,2)))/maxval(abs(b_f(:,:,2,2))) &
            &.lt. m_tol) &                                                      ! R_c << Z_s
            &stel_sym = .true.
        if (stel_sym) then
            call writo("The equilibrium configuration has stellarator &
                &symmetry")
        else
            call writo("The equilibrium configuration does not have &
                &stellarator symmetry")
        end if
        
        ! find out how many poloidal modes would be necessary
        rec_min_m = 1
        norm_b_h = maxval(abs(b_f))
        do id = 0,nr_m_max
            if (maxval(abs(b_f(:,id,:,1)/norm_b_h)).gt.m_tol .or. &             ! for R
                &maxval(abs(b_f(:,id,:,2)/norm_b_h)).gt.m_tol) &                ! for Z
                &rec_min_m = id
        end do
        call writo("Detected recommended number of poloidal modes: "//&
            &trim(i2str(rec_min_m)))
        
        ! possibly get maximum number of modes to plot
        max_n_b_output = rec_min_m
        call writo('Do you want to change the maximum number of modes &
            &from current '//trim(i2str(max_n_b_output))//'?')
        change_max_n_b_output = get_log(.false.)
        if (change_max_n_b_output) then
            call writo('Maximum number of modes to output?')
            max_n_b_output = get_int(lim_lo=1)
        end if
        
        ! interpolate for VMEC (V) and Jorek (J) output
        s_vj = [((kd-1._dp)/(size(s_vj)-1),kd=1,size(s_vj))]
        allocate(psi_t(grid_eq%n(3)))
        psi_t = eq_1%flux_t_E(:,0)/eq_1%flux_t_E(grid_eq%n(3),0)
        do id = 0,1
            ierr = spline(psi_t,eq_1%pres_E(:,id),s_vj,pres_vj(:,id),&
                &ord=norm_disc_prec_eq)
            chckerr('')
        end do
        if (use_normalization) then
            pres_vj = pres_vj*pres_0
            pres_vj(:,1) = pres_vj(:,1) / psi_0
        end if
        ierr = spline(psi_t,rbphi_h(:,0),s_vj,f_vj,ord=norm_disc_prec_eq)
        chckerr('')
        if (use_normalization) f_vj = f_vj * r_0*b_0
        ierr = spline(psi_t,ffp,s_vj,ffp_vj,ord=norm_disc_prec_eq)
        chckerr('')
        if (use_normalization) then
            ffp_vj = ffp_vj * (r_0*b_0)**2/psi_0
        end if
        ierr = spline(psi_t,flux_p_h(:,0),s_vj,flux_j,ord=norm_disc_prec_eq)
        chckerr('')
        if (use_normalization) flux_j = flux_j*psi_0
        ierr = spline(psi_t,eq_1%q_saf_E(:,0),s_vj,q_saf_vj,&
            &ord=norm_disc_prec_eq)
        chckerr('')
        ierr = spline(psi_t,-eq_1%rot_t_E(:,0),s_vj,rot_t_v,&
            &ord=norm_disc_prec_eq)
        chckerr('')
        ierr = spline(psi_t,i_tor*norm_transf(:,1),s_vj,i_tor_v,&
            &ord=norm_disc_prec_eq)
        chckerr('')
        ierr = spline(psi_t,i_tor*norm_transf(:,2),s_vj,i_tor_j,&
            &ord=norm_disc_prec_eq)
        chckerr('')
        if (use_normalization) i_tor_v = i_tor_v * r_0*b_0/mu_0_original
        if (use_normalization) i_tor_j = i_tor_j * r_0*b_0/mu_0_original
        
        ! output to VMEC input file
        open(hel_export_i,status='replace',file=trim(file_name),&
            &iostat=ierr)
        chckerr('Failed to open file')
        
        write(hel_export_i,"(A)") "!----- General Parameters -----"
        write(hel_export_i,"(A)") "&INDATA"
        write(hel_export_i,"(A)") "MGRID_FILE = 'NONE',"
        write(hel_export_i,"(A)") "PRECON_TYPE = 'GMRES'"
        write(hel_export_i,"(A)") "PREC2D_THRESHOLD = 1.E-9"
        write(hel_export_i,"(A)") "DELT = 1.00E+00,"
        write(hel_export_i,"(A)") "NS_ARRAY = 19, 39, 79, 159, 319"
        write(hel_export_i,"(A)") "LRFP = F"
        write(hel_export_i,"(A,L1)") "LASYM = ", .not.stel_sym
        write(hel_export_i,"(A)") "LFREEB = F"
        write(hel_export_i,"(A)") "NTOR = "//trim(i2str(nr_n-1))                ! -NTOR .. NTOR
        write(hel_export_i,"(A)") "MPOL = "//trim(i2str(max_n_b_output))        ! 0 .. MPOL-1
        write(hel_export_i,"(A)") "TCON0 = 1"
        write(hel_export_i,"(A)") "FTOL_ARRAY = 1.E-6, 1.E-6, 1.E-8, 1.E-10, &
            &5.000E-18,"
        write(hel_export_i,"(A)") "NITER = 100000,"
        write(hel_export_i,"(A)") "NSTEP = 200,"
        write(hel_export_i,"(A)") "NFP = "//trim(i2str(nfp))
        if (use_normalization) then
            write(hel_export_i,"(A)") "PHIEDGE = "//&
                &trim(r2str(-eq_1%flux_t_E(grid_eq%n(3),0)*psi_0))
        else
            write(hel_export_i,"(A)") "PHIEDGE = "//&
                &trim(r2str(-eq_1%flux_t_E(grid_eq%n(3),0)))
        end if
        write(hel_export_i,"(A)") "CURTOR = "//&
            &trim(r2str(i_tor_int(size(i_tor_int))))
        
        write(hel_export_i,"(A)") ""
        write(hel_export_i,"(A)") ""
        
        write(hel_export_i,"(A)") "!----- Pressure Parameters -----"
        write(hel_export_i,"(A)") "PMASS_TYPE = 'cubic_spline'"
        write(hel_export_i,"(A)") "GAMMA =  0.00000000000000E+00"
        write(hel_export_i,"(A)") ""
        write(hel_export_i,"(A)",advance="no") "AM_AUX_S ="
        do kd = 1,size(s_vj)
            write(hel_export_i,"(A1,ES23.16)") " ", s_vj(kd)
        end do
        write(hel_export_i,"(A)") ""
        write(hel_export_i,"(A)",advance="no") "AM_AUX_F ="
        do kd = 1,size(pres_vj,1)
            write(hel_export_i,"(A1,ES23.16)") " ", pres_vj(kd,0)
        end do
        
        write(hel_export_i,"(A)") ""
        write(hel_export_i,"(A)") ""
        
        write(hel_export_i,"(A)") &
            &"!----- Current/Iota Parameters -----"
        write(hel_export_i,"(A)") "NCURR = "//trim(i2str(ncurr))
        write(hel_export_i,"(A)") ""
        
        ! iota (is used if ncur = 0)
        write(hel_export_i,"(A)") "PIOTA_TYPE = 'Cubic_spline'"
        write(hel_export_i,"(A)") ""
        write(hel_export_i,"(A)",advance="no") "AI_AUX_S ="
        do kd = 1,size(s_vj)
            write(hel_export_i,"(A1,ES23.16)") " ", s_vj(kd)
        end do
        write(hel_export_i,"(A)") ""
        write(hel_export_i,"(A)",advance="no") "AI_AUX_F ="
        do kd = 1,size(rot_t_v)
            write(hel_export_i,"(A1,ES23.16)") " ", rot_t_v(kd)
        end do
        write(hel_export_i,"(A)") ""
        
        ! I_tor (is used if ncur = 1)
        write(hel_export_i,"(A)") "PCURR_TYPE = 'cubic_spline_Ip'"
        write(hel_export_i,"(A)") ""
        write(hel_export_i,"(A)",advance="no") "AC_AUX_S ="
        do kd = 1,size(s_vj)
            write(hel_export_i,"(A1,ES23.16)") " ", s_vj(kd)
        end do
        write(hel_export_i,"(A)") ""
        write(hel_export_i,"(A)",advance="no") "AC_AUX_F ="
        do kd = 1,size(rot_t_v)
            write(hel_export_i,"(A1,ES23.16)") " ", i_tor_v(kd)
        end do
        
        write(hel_export_i,"(A)") ""
        write(hel_export_i,"(A)") ""
        
        write(hel_export_i,"(A)") &
            &"!----- Boundary Shape Parameters -----"
        ierr = print_mode_numbers(hel_export_i,b_f(id_n_0,:,:,:),0,&
            &max_n_b_output)
        chckerr('')
        if (pert_eq) then
            do jd = 1,nr_n
                if (jd.eq.id_n_0) cycle                                         ! skip n = 0 as it is already written
                ierr = print_mode_numbers(hel_export_i,&
                    &b_f(jd,:,:,:),n_pert(jd),max_n_b_output)
                chckerr('')
            end do
        end if
        write(hel_export_i,"(A,ES23.16)") "RAXIS = ", rz_b_0(1)
        write(hel_export_i,"(A,ES23.16)") "ZAXIS = ", rz_b_0(2)
        write(hel_export_i,"(A)") "&END"
        
        close(hel_export_i)
        
        ! output to output file for free-boundary coil fitting in JOREK
        file_name = "flux_and_boundary_quantities_"//trim(eq_name)//'.jorek'
        open(hel_export_i,status='replace',file=trim(file_name),&
            &iostat=ierr)
        chckerr('Failed to open file')
        
        ! The normal derivatives in FFp are transformed for JOREK output.
        !   - The difference between the HELENA coordinate system (used in the E
        !   quantities here), and  the JOREK coordinate system is  the fact that
        !   HELENA uses  psi_pol/2pi as  the norma  coordinate while  JOREK uses
        !   psi_pol/psi_pol(s). This step therefore introduces a factor
        !       d/dpsi_J = psi_pol(s)/(2*pi)  d/dpsi_H
        ! However, JOREK  then asks for  a quantity  that has this  exact factor
        ! multiplied back into  it, so that the end results  does not require to
        ! be transformed back. The following lines are therefore commented out.
        !!FFp_VJ = FFp_VJ * max_flux_E/(2*pi)
        !!if (use_normalization) FFp_VJ = FFp_VJ * psi_0                          ! to scale max_flux_E
        if (use_normalization) then
            norm_j = [r_0*rmtog_h,rz_b_0(2),r_0*rmtog_h*b_0*bmtog_h]
        else
            norm_j = [1._dp,1._dp,1._dp]
        end if
        write(hel_export_i,"('! ',A)") 'normalization factors:'
        write(hel_export_i,"('R_geo = ',ES23.16,' ! [m]')") norm_j(1)
        write(hel_export_i,"('Z_geo = ',ES23.16,' ! [m]')") norm_j(2)
        write(hel_export_i,"('F0 = ',ES23.16,' ! [Tm]')") norm_j(3)
        write(hel_export_i,*) ''
        write(hel_export_i,"('! ',7(A23,' '))") 'pol. flux [Tm^2]', &
            &'normalized pol. flux []', 'mu_0 pressure [T^2]', 'F [Tm]', &
            &'-FFp [T^2 m^2/(Wb/rad)]', 'safety factor []', 'I_tor [A]'
        do kd = 1,size(flux_j)
            write(hel_export_i,"('  ',7(ES23.16,' '))") flux_j(kd), &
                &flux_j(kd)/flux_j(size(flux_j)), mu_0_original*pres_vj(kd,0), &
                &f_vj(kd), -ffp_vj(kd), q_saf_vj(kd), i_tor_j(kd)
        end do
        write(hel_export_i,*) ''
        write(hel_export_i,*) '! R [m] and Z [m] of boundary at psi [ ]'
        do kd = 1,n_b
            write(hel_export_i,"('R_boundary(',I4,') = ',ES23.16,&
                &', Z_boundary(',I4,') = ',ES23.16,&
                &', psi_boundary(',I4,') = ',ES23.16)") &
                &kd, bh_0(kd,1), kd, bh_0(kd,2), kd, 1._dp
        end do
        
        close(hel_export_i)
        
        ! output different files
        file_name = "jorek_ffprime"
        open(hel_export_i,status='replace',file=trim(file_name),&
            &iostat=ierr)
        chckerr('Failed to open file')
        !write(HEL_export_i,"('! ',2(A23,' '))") 'psi_norm [ ]', '-FFp [T]'
        do kd = 1,size(flux_j)
            write(hel_export_i,"('  ',2(ES23.16,' '))") &
                &flux_j(kd)/flux_j(size(flux_j)), -ffp_vj(kd)
        end do
        close(hel_export_i)
        file_name = "jorek_temperature"
        open(hel_export_i,status='replace',file=trim(file_name),&
            &iostat=ierr)
        chckerr('Failed to open file')
        !write(HEL_export_i,"('! ',2(A23,' '))") 'psi_norm [ ]', &
            !&'mu_0 pressure [T^2]'
        do kd = 1,size(flux_j)
            write(hel_export_i,"('  ',2(ES23.16,' '))") &
                &flux_j(kd)/flux_j(size(flux_j)), mu_0_original*pres_vj(kd,0)
        end do
        close(hel_export_i)
        
        ! user output
        call lvl_ud(-1)
        
        call writo('Done')
        
        ! wait
        call pause_prog
    contains
        ! plots the boundary of a toroidal configuration
        subroutine plot_boundary(B,m_lims,n,plot_name,plot_dim,plot_lims)
            ! input / output
            real(dp), intent(in) :: b(1:,0:,1:,1:)                              ! cosine and sine of fourier series (tor modes, pol modes, cos/sin (m theta_geo), R/Z)
            integer, intent(in) :: m_lims(2)                                    ! limits of poloidal mode numbers
            integer, intent(in) :: n(:)                                         ! toroidal mode numbers
            character(len=*), intent(in) :: plot_name                           ! name of plot
            integer, intent(in) :: plot_dim(2)                                  ! plot dimensions in geometrical angle
            real(dp), intent(in) :: plot_lims(2,2)                              ! limits of plot dimensions [pi]
            
            ! local variables
            real(dp), allocatable :: ang_plot(:,:,:)                            ! angles of plot (theta,zeta)
            real(dp), allocatable :: xyz_plot(:,:,:)                            ! coordinates of boundary (X,Y,Z)
            integer :: kd, id                                                   ! counters
            integer :: m                                                        ! local poloidal mode number
            
            ! set variables
            allocate(ang_plot(plot_dim(1),plot_dim(2),2))                       ! theta and zeta (geometrical)
            allocate(xyz_plot(plot_dim(1),plot_dim(2),3))                       ! X, Y and Z
            xyz_plot = 0._dp
            
            ! create grid
            do id = 1,plot_dim(1)
                ang_plot(id,:,1) = pi * (plot_lims(1,1) + (id-1._dp)/&
                    &(plot_dim(1)-1)*(plot_lims(2,1)-plot_lims(1,1)))
            end do
            do kd = 1,plot_dim(2)
                ang_plot(:,kd,2) = pi * (plot_lims(1,2) + (kd-1._dp)/&
                    &(plot_dim(2)-1)*(plot_lims(2,2)-plot_lims(1,2)))
            end do
            
            ! inverse Fourier transform
            do id = 1,size(n)                                                   ! toroidal modes
                do kd = 0,m_lims(2)-m_lims(1)                                   ! poloidal modes
                    m = m_lims(1)+kd  
                    
                    ! R
                    xyz_plot(:,:,1) = xyz_plot(:,:,1) + &
                        &b(id,kd,1,1)*cos(m*ang_plot(:,:,1)-&
                        &n(id)*ang_plot(:,:,2)) + &
                        &b(id,kd,2,1)*sin(m*ang_plot(:,:,1)-&
                        &n(id)*ang_plot(:,:,2))
                    ! Z
                    xyz_plot(:,:,3) = xyz_plot(:,:,3) + &
                        &b(id,kd,1,2)*cos(m*ang_plot(:,:,1)-&
                        &n(id)*ang_plot(:,:,2)) + &
                        &b(id,kd,2,2)*sin(m*ang_plot(:,:,1)-&
                        &n(id)*ang_plot(:,:,2))
                end do
            end do
            
            ! print cross-section (R,Z)
            call print_ex_2d(['cross_section_'//trim(plot_name)],&
                &'cross_section_'//trim(plot_name),xyz_plot(:,:,3),&
                &x=xyz_plot(:,:,1),draw=.false.)
            call draw_ex(['cross_section_'//trim(plot_name)],&
                &'cross_section_'//trim(plot_name),plot_dim(2),1,.false.)
            call print_ex_2d(['cross_section_'//trim(plot_name)//'_inv'],&
                &'cross_section_'//trim(plot_name)//'_inv',&
                &transpose(xyz_plot(:,:,3)),x=transpose(xyz_plot(:,:,1)),&
                &draw=.false.)
            call draw_ex(['cross_section_'//trim(plot_name)//'_inv'],&
                &'cross_section_'//trim(plot_name)//'_inv',plot_dim(1),1,&
                &.false.)
            
            ! convert to X, Y, Z
            xyz_plot(:,:,2) = xyz_plot(:,:,1)*sin(ang_plot(:,:,2))
            xyz_plot(:,:,1) = xyz_plot(:,:,1)*cos(ang_plot(:,:,2))
            
            ! print
            call print_ex_3d('plasma boundary',trim(plot_name),xyz_plot(:,:,3),&
                &x=xyz_plot(:,:,1),y=xyz_plot(:,:,2),draw=.false.)
            call draw_ex(['plasma boundary'],trim(plot_name),1,2,.false.)
        end subroutine plot_boundary
        
        ! print the mode numbers
        integer function print_mode_numbers(file_i,B,n_pert,max_n_B_output) &
            &result(ierr)
            character(*), parameter :: rout_name = 'print_mode_numbers'
            
            ! input / output
            integer, intent(in) :: file_i                                       ! file to output flux quantities for VMEC export
            real(dp), intent(in) :: b(:,:,:)                                    ! cosine and sine of fourier series for R and Z
            integer, intent(in) :: n_pert                                       ! toroidal mode number
            integer, intent(in) :: max_n_b_output                               ! maximum number of modes to output
            
            ! local variables
            integer :: kd                                                       ! counter
            integer :: m                                                        ! counter
            character :: var_name                                               ! name of variables (R or Z)
            character(len=2*max_str_ln) :: temp_output_str                      ! temporary output string
            
            ! initialize ierr
            ierr = 0
            
            do kd = 1,2                                                         ! R and Z
                select case (kd)
                    case (1)
                        var_name = 'R'
                    case (2)
                        var_name = 'Z'
                    case default
                        var_name = '?'
                end select
                
                ! output to file
                do m = 0,min(size(b,1)-1,max_n_b_output)
                    write(temp_output_str,"(' ',A,'BC(',I4,', ',I4,') = ',&
                        &ES23.16,'   ',A,'BS(',I4,', ',I4,') = ',ES23.16)") &
                        &var_name,n_pert,m,b(m+1,1,kd), &
                        &var_name,n_pert,m,b(m+1,2,kd)
                    write(unit=file_i,fmt='(A)',iostat=ierr) &
                        &trim(temp_output_str)
                    chckerr('Failed to write')
                end do
                write(unit=file_i,fmt="(A)",iostat=ierr) ""
                chckerr('Failed to write')
            end do
        end function print_mode_numbers
    end function create_vmec_input
    
    integer function print_output_eq_1(grid_eq,eq,data_name) result(ierr)
        use num_vars, only: pb3d_name
        use hdf5_ops, only: print_hdf5_arrs
        use hdf5_vars, only: dealloc_var_1d, var_1d_type, &
            &max_dim_var_1d
        use grid_utilities, only: trim_grid
        
        character(*), parameter :: rout_name = 'print_output_eq_1'
        
        ! input / output
        type(grid_type), intent(in) :: grid_eq
        type(eq_1_type), intent(in) :: eq
        character(len=*), intent(in) :: data_name
        
        ! local variables
        integer :: norm_id(2)                                                   ! untrimmed normal indices for trimmed grids
        type(var_1d_type), allocatable, target :: eq_1d(:)                      ! 1D equivalent of eq. variables
        type(var_1d_type), pointer :: eq_1d_loc => null()                       ! local element in eq_1D
        type(grid_type) :: grid_trim                                            ! trimmed grid
        integer :: id                                                           ! counter
        integer :: loc_size                                                     ! local size
        
        ! initialize ierr
        ierr = 0
        
        ! user output
        call writo('Write flux equilibrium variables to output file')
        call lvl_ud(1)
        
        ! trim grids
        ierr = trim_grid(grid_eq,grid_trim,norm_id)
        chckerr('')
        
        ! set up the 1D equivalents of the equilibrium variables
        allocate(eq_1d(max_dim_var_1d))
        
        ! Set up common variables eq_1D
        id = 1
        
        ! pres_FD
        eq_1d_loc => eq_1d(id); id = id+1
        eq_1d_loc%var_name = 'pres_FD'
        allocate(eq_1d_loc%tot_i_min(2),eq_1d_loc%tot_i_max(2))
        allocate(eq_1d_loc%loc_i_min(2),eq_1d_loc%loc_i_max(2))
        eq_1d_loc%tot_i_min = [1,0]
        eq_1d_loc%tot_i_max = [grid_trim%n(3),size(eq%pres_FD,2)-1]
        eq_1d_loc%loc_i_min = [grid_trim%i_min,0]
        eq_1d_loc%loc_i_max = [grid_trim%i_max,size(eq%pres_FD,2)-1]
        loc_size = size(eq%pres_FD(norm_id(1):norm_id(2),:))
        allocate(eq_1d_loc%p(loc_size))
        eq_1d_loc%p = reshape(eq%pres_FD(norm_id(1):norm_id(2),:),[loc_size])
        
        ! q_saf_FD
        eq_1d_loc => eq_1d(id); id = id+1
        eq_1d_loc%var_name = 'q_saf_FD'
        allocate(eq_1d_loc%tot_i_min(2),eq_1d_loc%tot_i_max(2))
        allocate(eq_1d_loc%loc_i_min(2),eq_1d_loc%loc_i_max(2))
        eq_1d_loc%tot_i_min = [1,0]
        eq_1d_loc%tot_i_max = [grid_trim%n(3),size(eq%q_saf_FD,2)-1]
        eq_1d_loc%loc_i_min = [grid_trim%i_min,0]
        eq_1d_loc%loc_i_max = [grid_trim%i_max,size(eq%q_saf_FD,2)-1]
        loc_size = size(eq%q_saf_FD(norm_id(1):norm_id(2),:))
        allocate(eq_1d_loc%p(loc_size))
        eq_1d_loc%p = reshape(eq%q_saf_FD(norm_id(1):norm_id(2),:),[loc_size])
        
        ! rot_t_FD
        eq_1d_loc => eq_1d(id); id = id+1
        eq_1d_loc%var_name = 'rot_t_FD'
        allocate(eq_1d_loc%tot_i_min(2),eq_1d_loc%tot_i_max(2))
        allocate(eq_1d_loc%loc_i_min(2),eq_1d_loc%loc_i_max(2))
        eq_1d_loc%tot_i_min = [1,0]
        eq_1d_loc%tot_i_max = [grid_trim%n(3),size(eq%rot_t_FD,2)-1]
        eq_1d_loc%loc_i_min = [grid_trim%i_min,0]
        eq_1d_loc%loc_i_max = [grid_trim%i_max,size(eq%rot_t_FD,2)-1]
        loc_size = size(eq%rot_t_FD(norm_id(1):norm_id(2),:))
        allocate(eq_1d_loc%p(loc_size))
        eq_1d_loc%p = reshape(eq%rot_t_FD(norm_id(1):norm_id(2),:),[loc_size])
        
        ! flux_p_FD
        eq_1d_loc => eq_1d(id); id = id+1
        eq_1d_loc%var_name = 'flux_p_FD'
        allocate(eq_1d_loc%tot_i_min(2),eq_1d_loc%tot_i_max(2))
        allocate(eq_1d_loc%loc_i_min(2),eq_1d_loc%loc_i_max(2))
        eq_1d_loc%tot_i_min = [1,0]
        eq_1d_loc%tot_i_max = [grid_trim%n(3),size(eq%flux_p_FD,2)-1]
        eq_1d_loc%loc_i_min = [grid_trim%i_min,0]
        eq_1d_loc%loc_i_max = [grid_trim%i_max,size(eq%flux_p_FD,2)-1]
        loc_size = size(eq%flux_p_FD(norm_id(1):norm_id(2),:))
        allocate(eq_1d_loc%p(loc_size))
        eq_1d_loc%p = reshape(eq%flux_p_FD(norm_id(1):norm_id(2),:),[loc_size])
        
        ! flux_t_FD
        eq_1d_loc => eq_1d(id); id = id+1
        eq_1d_loc%var_name = 'flux_t_FD'
        allocate(eq_1d_loc%tot_i_min(2),eq_1d_loc%tot_i_max(2))
        allocate(eq_1d_loc%loc_i_min(2),eq_1d_loc%loc_i_max(2))
        eq_1d_loc%tot_i_min = [1,0]
        eq_1d_loc%tot_i_max = [grid_trim%n(3),size(eq%flux_t_FD,2)-1]
        eq_1d_loc%loc_i_min = [grid_trim%i_min,0]
        eq_1d_loc%loc_i_max = [grid_trim%i_max,size(eq%flux_t_FD,2)-1]
        loc_size = size(eq%flux_t_FD(norm_id(1):norm_id(2),:))
        allocate(eq_1d_loc%p(loc_size))
        eq_1d_loc%p = reshape(eq%flux_t_FD(norm_id(1):norm_id(2),:),[loc_size])
        
        ! rho
        eq_1d_loc => eq_1d(id); id = id+1
        eq_1d_loc%var_name = 'rho'
        allocate(eq_1d_loc%tot_i_min(1),eq_1d_loc%tot_i_max(1))
        allocate(eq_1d_loc%loc_i_min(1),eq_1d_loc%loc_i_max(1))
        eq_1d_loc%tot_i_min = 1
        eq_1d_loc%tot_i_max = grid_trim%n(3)
        eq_1d_loc%loc_i_min = grid_trim%i_min
        eq_1d_loc%loc_i_max = grid_trim%i_max
        loc_size = size(eq%rho(norm_id(1):norm_id(2)))
        allocate(eq_1d_loc%p(loc_size))
        eq_1d_loc%p = eq%rho(norm_id(1):norm_id(2))
        
        
        ! write
        ierr = print_hdf5_arrs(eq_1d(1:id-1),pb3d_name,trim(data_name),&
            &ind_print=.not.grid_trim%divided)
        chckerr('')
        
        ! clean up
        call grid_trim%dealloc()
        call dealloc_var_1d(eq_1d)
        nullify(eq_1d_loc)
        
        ! user output
        call lvl_ud(-1)
    end function print_output_eq_1
    integer function print_output_eq_2(grid_eq,eq,data_name,rich_lvl,par_div,&
        &dealloc_vars) result(ierr)
        use num_vars, only: pb3d_name, eq_jobs_lims, eq_job_nr
        use hdf5_ops, only: print_hdf5_arrs
        use hdf5_vars, only: dealloc_var_1d, var_1d_type, &
            &max_dim_var_1d
        use grid_utilities, only: trim_grid
        
        character(*), parameter :: rout_name = 'print_output_eq_2'
        
        ! input / output
        type(grid_type), intent(in) :: grid_eq
        type(eq_2_type), intent(inout) :: eq
        character(len=*), intent(in) :: data_name
        integer, intent(in), optional :: rich_lvl
        logical, intent(in), optional :: par_div
        logical, intent(in), optional :: dealloc_vars
        
        ! local variables
        integer :: n_tot(3)                                                     ! total n
        integer :: par_id(2)                                                    ! local parallel interval
        integer :: norm_id(2)                                                   ! untrimmed normal indices for trimmed grids
        type(var_1d_type), allocatable, target :: eq_1d(:)                      ! 1D equivalent of eq. variables
        type(var_1d_type), pointer :: eq_1d_loc => null()                       ! local element in eq_1D
        type(grid_type) :: grid_trim                                            ! trimmed grid
        integer :: id                                                           ! counter
        logical :: par_div_loc                                                  ! local par_div
        integer :: loc_size                                                     ! local size
        logical :: dealloc_vars_loc                                             ! local dealloc_vars
        
        ! initialize ierr
        ierr = 0
        
        ! user output
        call writo('Write metric equilibrium variables to output file')
        call lvl_ud(1)
        
        ! trim grids
        ierr = trim_grid(grid_eq,grid_trim,norm_id)
        chckerr('')
        
        ! set local par_div
        par_div_loc = .false.
        if (present(par_div)) par_div_loc = par_div
        
        ! set total n and parallel interval
        n_tot = grid_trim%n
        par_id = [1,n_tot(1)]
        if (grid_trim%n(1).gt.0 .and. par_div_loc) then                         ! total grid includes all equilibrium jobs
            n_tot(1) = maxval(eq_jobs_lims)-minval(eq_jobs_lims)+1
            par_id = eq_jobs_lims(:,eq_job_nr)
        end if
        
        ! set up local dealloc_vars
        dealloc_vars_loc = .false.
        if (present(dealloc_vars)) dealloc_vars_loc = dealloc_vars
        
        ! set up the 1D equivalents of the equilibrium variables
        allocate(eq_1d(max_dim_var_1d))
        
        ! Set up common variables eq_1D
        id = 1
        
        ! g_FD
        eq_1d_loc => eq_1d(id); id = id+1
        eq_1d_loc%var_name = 'g_FD'
        allocate(eq_1d_loc%tot_i_min(7),eq_1d_loc%tot_i_max(7))
        allocate(eq_1d_loc%loc_i_min(7),eq_1d_loc%loc_i_max(7))
        eq_1d_loc%tot_i_min = [1,1,1,1,0,0,0]
        eq_1d_loc%tot_i_max = [n_tot,6,size(eq%g_FD,5)-1,size(eq%g_FD,6)-1,&
            &size(eq%g_FD,7)-1]
        eq_1d_loc%loc_i_min = [par_id(1),1,grid_trim%i_min,1,0,0,0]
        eq_1d_loc%loc_i_max = [par_id(2),n_tot(2),grid_trim%i_max,6,&
            &size(eq%g_FD,5)-1,size(eq%g_FD,6)-1,size(eq%g_FD,7)-1]
        loc_size = size(eq%g_FD(:,:,norm_id(1):norm_id(2),:,:,:,:))
        allocate(eq_1d_loc%p(loc_size))
        eq_1d_loc%p = reshape(eq%g_FD(:,:,norm_id(1):norm_id(2),:,:,:,:),&
            &[loc_size])
        if (dealloc_vars_loc) deallocate(eq%g_FD)
        
        ! h_FD
        eq_1d_loc => eq_1d(id); id = id+1
        eq_1d_loc%var_name = 'h_FD'
        allocate(eq_1d_loc%tot_i_min(7),eq_1d_loc%tot_i_max(7))
        allocate(eq_1d_loc%loc_i_min(7),eq_1d_loc%loc_i_max(7))
        eq_1d_loc%tot_i_min = [1,1,1,1,0,0,0]
        eq_1d_loc%tot_i_max = [n_tot,6,size(eq%h_FD,5)-1,size(eq%h_FD,6)-1,&
            &size(eq%h_FD,7)-1]
        eq_1d_loc%loc_i_min = [par_id(1),1,grid_trim%i_min,1,0,0,0]
        eq_1d_loc%loc_i_max = [par_id(2),n_tot(2),grid_trim%i_max,6,&
            &size(eq%h_FD,5)-1,size(eq%h_FD,6)-1,size(eq%h_FD,7)-1]
        loc_size = size(eq%h_FD(:,:,norm_id(1):norm_id(2),:,:,:,:))
        allocate(eq_1d_loc%p(loc_size))
        eq_1d_loc%p = reshape(eq%h_FD(:,:,norm_id(1):norm_id(2),:,:,:,:),&
            &[loc_size])
        if (dealloc_vars_loc) deallocate(eq%h_FD)
        
        ! jac_FD
        eq_1d_loc => eq_1d(id); id = id+1
        eq_1d_loc%var_name = 'jac_FD'
        allocate(eq_1d_loc%tot_i_min(6),eq_1d_loc%tot_i_max(6))
        allocate(eq_1d_loc%loc_i_min(6),eq_1d_loc%loc_i_max(6))
        eq_1d_loc%tot_i_min = [1,1,1,0,0,0]
        eq_1d_loc%tot_i_max = [n_tot,size(eq%jac_FD,4)-1,size(eq%jac_FD,5)-1,&
            &size(eq%jac_FD,6)-1]
        eq_1d_loc%loc_i_min = [par_id(1),1,grid_trim%i_min,0,0,0]
        eq_1d_loc%loc_i_max = [par_id(2),n_tot(2),grid_trim%i_max,&
            &size(eq%jac_FD,4)-1,size(eq%jac_FD,5)-1,size(eq%jac_FD,6)-1]
        loc_size = size(eq%jac_FD(:,:,norm_id(1):norm_id(2),:,:,:))
        allocate(eq_1d_loc%p(loc_size))
        eq_1d_loc%p = reshape(eq%jac_FD(:,:,norm_id(1):norm_id(2),:,:,:),&
            &[loc_size])
        if (dealloc_vars_loc) deallocate(eq%jac_FD)
        
        ! S
        eq_1d_loc => eq_1d(id); id = id+1
        eq_1d_loc%var_name = 'S'
        allocate(eq_1d_loc%tot_i_min(3),eq_1d_loc%tot_i_max(3))
        allocate(eq_1d_loc%loc_i_min(3),eq_1d_loc%loc_i_max(3))
        eq_1d_loc%tot_i_min = [1,1,1]
        eq_1d_loc%tot_i_max = n_tot
        eq_1d_loc%loc_i_min = [par_id(1),1,grid_trim%i_min]
        eq_1d_loc%loc_i_max = [par_id(2),n_tot(2),grid_trim%i_max]
        loc_size = size(eq%S(:,:,norm_id(1):norm_id(2)))
        allocate(eq_1d_loc%p(loc_size))
        eq_1d_loc%p = reshape(eq%S(:,:,norm_id(1):norm_id(2)),&
            &[loc_size])
        if (dealloc_vars_loc) deallocate(eq%S)
        
        ! kappa_n
        eq_1d_loc => eq_1d(id); id = id+1
        eq_1d_loc%var_name = 'kappa_n'
        allocate(eq_1d_loc%tot_i_min(3),eq_1d_loc%tot_i_max(3))
        allocate(eq_1d_loc%loc_i_min(3),eq_1d_loc%loc_i_max(3))
        eq_1d_loc%tot_i_min = [1,1,1]
        eq_1d_loc%tot_i_max = n_tot
        eq_1d_loc%loc_i_min = [par_id(1),1,grid_trim%i_min]
        eq_1d_loc%loc_i_max = [par_id(2),n_tot(2),grid_trim%i_max]
        loc_size = size(eq%kappa_n(:,:,norm_id(1):norm_id(2)))
        allocate(eq_1d_loc%p(loc_size))
        eq_1d_loc%p = reshape(eq%kappa_n(:,:,norm_id(1):norm_id(2)),&
            &[loc_size])
        if (dealloc_vars_loc) deallocate(eq%kappa_n)
        
        ! kappa_g
        eq_1d_loc => eq_1d(id); id = id+1
        eq_1d_loc%var_name = 'kappa_g'
        allocate(eq_1d_loc%tot_i_min(3),eq_1d_loc%tot_i_max(3))
        allocate(eq_1d_loc%loc_i_min(3),eq_1d_loc%loc_i_max(3))
        eq_1d_loc%tot_i_min = [1,1,1]
        eq_1d_loc%tot_i_max = n_tot
        eq_1d_loc%loc_i_min = [par_id(1),1,grid_trim%i_min]
        eq_1d_loc%loc_i_max = [par_id(2),n_tot(2),grid_trim%i_max]
        loc_size = size(eq%kappa_g(:,:,norm_id(1):norm_id(2)))
        allocate(eq_1d_loc%p(loc_size))
        eq_1d_loc%p = reshape(eq%kappa_g(:,:,norm_id(1):norm_id(2)),&
            &[loc_size])
        if (dealloc_vars_loc) deallocate(eq%kappa_g)
        
        ! sigma
        eq_1d_loc => eq_1d(id); id = id+1
        eq_1d_loc%var_name = 'sigma'
        allocate(eq_1d_loc%tot_i_min(3),eq_1d_loc%tot_i_max(3))
        allocate(eq_1d_loc%loc_i_min(3),eq_1d_loc%loc_i_max(3))
        eq_1d_loc%tot_i_min = [1,1,1]
        eq_1d_loc%tot_i_max = n_tot
        eq_1d_loc%loc_i_min = [par_id(1),1,grid_trim%i_min]
        eq_1d_loc%loc_i_max = [par_id(2),n_tot(2),grid_trim%i_max]
        loc_size = size(eq%sigma(:,:,norm_id(1):norm_id(2)))
        allocate(eq_1d_loc%p(loc_size))
        eq_1d_loc%p = reshape(eq%sigma(:,:,norm_id(1):norm_id(2)),&
            &[loc_size])
        if (dealloc_vars_loc) deallocate(eq%sigma)
        
        ! write
        ierr = print_hdf5_arrs(eq_1d(1:id-1),pb3d_name,trim(data_name),&
            &rich_lvl=rich_lvl,ind_print=.not.grid_trim%divided)
        chckerr('')
        
        ! clean up
        call grid_trim%dealloc()
        call dealloc_var_1d(eq_1d)
        nullify(eq_1d_loc)
        
        ! user output
        call lvl_ud(-1)
    end function print_output_eq_2
    
    integer function redistribute_output_eq_1(grid,grid_out,eq,eq_out) &
        &result(ierr)
        use mpi_utilities, only: redistribute_var
        
        character(*), parameter :: rout_name = 'redistribute_output_eq_1'
        
        ! input / output
        type(grid_type), intent(in) :: grid
        type(grid_type), intent(in) :: grid_out
        type(eq_1_type), intent(in) :: eq
        type(eq_1_type), intent(inout) :: eq_out
        
        ! local variables
        integer :: id                                                           ! counter
        
        ! initialize ierr
        ierr = 0
        
        ! user output
        call writo('Redistribute flux equilibrium variables')
        call lvl_ud(1)
        
        ! test
        if (grid%n(1).ne.grid_out%n(1) .or. grid%n(2).ne.grid_out%n(2)) then
            ierr = 1
            chckerr('grid and grid_out are not compatible')
        end if
        
        ! create redistributed flux equilibrium variables
        call eq_out%init(grid_out,setup_e=.false.,setup_f=.true.)
        
        ! for all derivatives
        do id = 0,max_deriv+1
            ! pres_FD
            ierr = redistribute_var(eq%pres_FD(:,id),eq_out%pres_FD(:,id),&
                &[grid%i_min,grid%i_max],[grid_out%i_min,grid_out%i_max])
            chckerr('')
            
            ! q_saf_FD
            ierr = redistribute_var(eq%q_saf_FD(:,id),eq_out%q_saf_FD(:,id),&
                &[grid%i_min,grid%i_max],[grid_out%i_min,grid_out%i_max])
            chckerr('')
            
            ! rot_t_FD
            ierr = redistribute_var(eq%rot_t_FD(:,id),eq_out%rot_t_FD(:,id),&
                &[grid%i_min,grid%i_max],[grid_out%i_min,grid_out%i_max])
            chckerr('')
            
            ! flux_p_FD
            ierr = redistribute_var(eq%flux_p_FD(:,id),eq_out%flux_p_FD(:,id),&
                &[grid%i_min,grid%i_max],[grid_out%i_min,grid_out%i_max])
            chckerr('')
            
            ! flux_t_FD
            ierr = redistribute_var(eq%flux_t_FD(:,id),eq_out%flux_t_FD(:,id),&
                &[grid%i_min,grid%i_max],[grid_out%i_min,grid_out%i_max])
            chckerr('')
        end do
        
        ! rho
        ierr = redistribute_var(eq%rho,eq_out%rho,&
            &[grid%i_min,grid%i_max],[grid_out%i_min,grid_out%i_max])
        chckerr('')
        
        ! user output
        call lvl_ud(-1)
    end function redistribute_output_eq_1
    integer function redistribute_output_eq_2(grid,grid_out,eq,eq_out) &
        &result(ierr)
        use mpi_utilities, only: redistribute_var
        
        character(*), parameter :: rout_name = 'redistribute_output_eq_2'
        
        ! input / output
        type(grid_type), intent(in) :: grid
        type(grid_type), intent(in) :: grid_out
        type(eq_2_type), intent(in) :: eq
        type(eq_2_type), intent(inout) :: eq_out
        
        ! local variables
        integer :: id, jd, kd, ld                                               ! counters
        integer :: lims(2), lims_dis(2)                                         ! limits and distributed limits, taking into account the angular extent
        integer :: siz(3), siz_dis(3)                                           ! size for geometric part of variable
        real(dp), allocatable :: temp_var(:)                                    ! temporary variable
        
        ! initialize ierr
        ierr = 0
        
        ! user output
        call writo('Redistribute metric equilibrium variables')
        call lvl_ud(1)
        
        ! test
        if (grid%n(1).ne.grid_out%n(1) .or. grid%n(2).ne.grid_out%n(2)) then
            ierr = 1
            chckerr('grid and grid_out are not compatible')
        end if
        
        ! create redistributed metric equilibrium variables
        call eq_out%init(grid_out,setup_e=.false.,setup_f=.true.)
        
        ! set up limits taking into account angular extent and temporary var
        lims(1) = product(grid%n(1:2))*(grid%i_min-1)+1
        lims(2) = product(grid%n(1:2))*grid%i_max
        lims_dis(1) = product(grid%n(1:2))*(grid_out%i_min-1)+1
        lims_dis(2) = product(grid%n(1:2))*grid_out%i_max
        siz = [grid%n(1:2),grid%loc_n_r]
        siz_dis = [grid_out%n(1:2),grid_out%loc_n_r]
        allocate(temp_var(product(siz_dis)))
        
        ! for all derivatives and metric factors
        do jd = 0,max_deriv
            do kd = 0,max_deriv
                do ld = 0,max_deriv
                    do id = 1,size(eq%g_FD,4)
                        ! g_FD
                        ierr = redistribute_var(reshape(&
                            &eq%g_FD(:,:,:,id,jd,kd,ld),[product(siz)]),&
                            &temp_var,lims,lims_dis)
                        chckerr('')
                        eq_out%g_FD(:,:,:,id,jd,kd,ld) = &
                            &reshape(temp_var,siz_dis)
                        
                        ! h_FD
                        ierr = redistribute_var(reshape(&
                            &eq%h_FD(:,:,:,id,jd,kd,ld),[product(siz)]),&
                            &temp_var,lims,lims_dis)
                        chckerr('')
                        eq_out%h_FD(:,:,:,id,jd,kd,ld) = &
                            &reshape(temp_var,siz_dis)
                    end do
                    ! jac_FD
                    ierr = redistribute_var(reshape(&
                        &eq%jac_FD(:,:,:,jd,kd,ld),[product(siz)]),&
                        &temp_var,lims,lims_dis)
                    chckerr('')
                    eq_out%jac_FD(:,:,:,jd,kd,ld) = &
                        &reshape(temp_var,siz_dis)
                end do
            end do
        end do
        
        ! S
        ierr = redistribute_var(reshape(eq%S,[product(siz)]),temp_var,&
            &lims,lims_dis)
        chckerr('')
        eq_out%S = reshape(temp_var,siz_dis)
        
        ! kappa_n
        ierr = redistribute_var(reshape(eq%kappa_n,[product(siz)]),temp_var,&
            &lims,lims_dis)
        chckerr('')
        eq_out%kappa_n = reshape(temp_var,siz_dis)
        
        ! kappa_g
        ierr = redistribute_var(reshape(eq%kappa_g,[product(siz)]),temp_var,&
            &lims,lims_dis)
        chckerr('')
        eq_out%kappa_g = reshape(temp_var,siz_dis)
        
        ! sigma
        ierr = redistribute_var(reshape(eq%sigma,[product(siz)]),temp_var,&
            &lims,lims_dis)
        chckerr('')
        eq_out%sigma = reshape(temp_var,siz_dis)
        
        ! user output
        call lvl_ud(-1)
    end function redistribute_output_eq_2
    
    integer function calc_rzl_ind(grid_eq,eq,deriv) result(ierr)
        use vmec_utilities, only: fourier2real
        use vmec_vars, only: r_v_c, r_v_s, z_v_c, z_v_s, l_v_c, l_v_s, is_asym_v
        
        character(*), parameter :: rout_name = 'calc_RZL_ind'
        
        ! input / output
        type(grid_type), intent(in) :: grid_eq
        type(eq_2_type), intent(inout) :: eq
        integer, intent(in) :: deriv(3)
        
        ! initialize ierr
        ierr = 0
        
#if ldebug
        ! check the derivatives requested
        ierr = check_deriv(deriv,max_deriv+1,'calc_RZL')
        chckerr('')
#endif
        
        ! calculate the variables R,Z and their derivatives
        ierr = fourier2real(r_v_c(:,grid_eq%i_min:grid_eq%i_max,deriv(1)),&
            &r_v_s(:,grid_eq%i_min:grid_eq%i_max,deriv(1)),&
            &grid_eq%trigon_factors,eq%R_E(:,:,:,deriv(1),deriv(2),deriv(3)),&
            &sym=[.true.,is_asym_v],deriv=[deriv(2),deriv(3)])
        chckerr('')
        ierr = fourier2real(z_v_c(:,grid_eq%i_min:grid_eq%i_max,deriv(1)),&
            &z_v_s(:,grid_eq%i_min:grid_eq%i_max,deriv(1)),&
            &grid_eq%trigon_factors,eq%Z_E(:,:,:,deriv(1),deriv(2),deriv(3)),&
            &sym=[is_asym_v,.true.],deriv=[deriv(2),deriv(3)])
        chckerr('')
        ierr = fourier2real(l_v_c(:,grid_eq%i_min:grid_eq%i_max,deriv(1)),&
            &l_v_s(:,grid_eq%i_min:grid_eq%i_max,deriv(1)),&
            &grid_eq%trigon_factors,eq%L_E(:,:,:,deriv(1),deriv(2),deriv(3)),&
            &sym=[is_asym_v,.true.],deriv=[deriv(2),deriv(3)])
        chckerr('')
    end function calc_rzl_ind
    integer function calc_rzl_arr(grid_eq,eq,deriv) result(ierr)
        character(*), parameter :: rout_name = 'calc_RZL_arr'
        
        ! input / output
        type(grid_type), intent(in) :: grid_eq
        type(eq_2_type), intent(inout) :: eq
        integer, intent(in) :: deriv(:,:)
        
        ! local variables
        integer :: id
        
        ! initialize ierr
        ierr = 0
        
        do id = 1, size(deriv,2)
            ierr = calc_rzl_ind(grid_eq,eq,deriv(:,id))
            chckerr('')
        end do
    end function calc_rzl_arr
    
    integer function calc_g_c_ind(eq,deriv) result(ierr)
        use num_utilities, only: add_arr_mult, c
        
        character(*), parameter :: rout_name = 'calc_g_C_ind'
        
        ! input / output
        type(eq_2_type), intent(inout) :: eq
        integer, intent(in) :: deriv(:)
        
        ! initialize ierr
        ierr = 0
        
#if ldebug
        ! check the derivatives requested
        ierr = check_deriv(deriv,max_deriv,'calc_g_C')
        chckerr('')
#endif
        
        ! initialize
        eq%g_C(:,:,:,:,deriv(1),deriv(2),deriv(3)) = 0._dp
        
        ! calculate
        if (sum(deriv).eq.0) then
            eq%g_C(:,:,:,c([1,1],.true.),deriv(1),deriv(2),deriv(3)) = 1.0_dp
            eq%g_C(:,:,:,c([3,3],.true.),deriv(1),deriv(2),deriv(3)) = 1.0_dp
        end if
        ierr = add_arr_mult(eq%R_E,eq%R_E,&
            &eq%g_C(:,:,:,c([2,2],.true.),deriv(1),deriv(2),deriv(3)),deriv)
        chckerr('')
    end function calc_g_c_ind
    integer function calc_g_c_arr(eq,deriv) result(ierr)
        character(*), parameter :: rout_name = 'calc_g_C_arr'
        
        ! input / output
        type(eq_2_type), intent(inout) :: eq
        integer, intent(in) :: deriv(:,:)
        
        ! local variables
        integer :: id
        
        ! initialize ierr
        ierr = 0
        
        do id = 1, size(deriv,2)
            ierr = calc_g_c_ind(eq,deriv(:,id))
            chckerr('')
        end do
    end function calc_g_c_arr
    
    integer function calc_g_v_ind(eq,deriv) result(ierr)
        use eq_utilities, only: calc_g
        
        character(*), parameter :: rout_name = 'calc_g_V_ind'
        
        ! input / output
        type(eq_2_type), intent(inout) :: eq
        integer, intent(in) :: deriv(:)
        
        ! initialize ierr
        ierr = 0
        
#if ldebug
        ! check the derivatives requested
        ierr = check_deriv(deriv,max_deriv,'calc_g_V')
        chckerr('')
#endif
        
        ierr = calc_g(eq%g_C,eq%T_VC,eq%g_E,deriv,max_deriv)
        chckerr('')
    end function calc_g_v_ind
    integer function calc_g_v_arr(eq,deriv) result(ierr)
        character(*), parameter :: rout_name = 'calc_g_V_arr'
        
        ! input / output
        type(eq_2_type), intent(inout) :: eq
        integer, intent(in) :: deriv(:,:)
        
        ! local variables
        integer :: id
        
        ! initialize ierr
        ierr = 0
        
        do id = 1, size(deriv,2)
            ierr = calc_g_v_ind(eq,deriv(:,id))
            chckerr('')
        end do
    end function calc_g_v_arr
    
    integer function calc_g_h_ind(grid_eq,eq,deriv) result(ierr)
        use num_vars, only: norm_disc_prec_eq
        use helena_vars, only: ias, nchi, r_h, z_h, chi_h, h_h_33
        use num_utilities, only: c, spline
        use ezspline_obj
        use ezspline
        
        character(*), parameter :: rout_name = 'calc_g_H_ind'
        
        ! input / output
        type(grid_type), intent(in) :: grid_eq
        type(eq_2_type), intent(inout) :: eq
        integer, intent(in) :: deriv(:)
        
        ! local variables
        type(ezspline2_r8) :: f_spl(2)                                          ! spline object for interpolation, even and odd
        character(len=max_str_ln) :: err_msg                                    ! error message
        integer :: id, jd, kd, ld                                               ! counters
        integer :: bcs(2,3)                                                     ! boundary conditions (theta(even), theta(odd), r)
        integer :: bc_ld(6)                                                     ! boundary condition type for each metric element
        real(dp) :: bcs_val(2,3)                                                ! values for boundary conditions
        real(dp), allocatable :: rchi(:,:), rpsi(:,:)                           ! chi and psi derivatives of R
        real(dp), allocatable :: zchi(:,:), zpsi(:,:)                           ! chi and psi derivatives of Z
        
        ! initialize ierr
        ierr = 0
        
#if ldebug
        ! check the derivatives requested
        ierr = check_deriv(deriv,max_deriv,'calc_g_H')
        chckerr('')
#endif
        
        ! set up boundary conditions
        if (ias.eq.0) then                                                      ! top-bottom symmetric
            bcs(:,1) = [1,1]                                                    ! theta(even): zero first derivative
            bcs(:,2) = [2,2]                                                    ! theta(odd): zero first derivative
        else
            bcs(:,1) = [-1,-1]                                                  ! theta(even): periodic
            bcs(:,2) = [-1,-1]                                                  ! theta(odd): periodic
        end if
        bcs(:,3) = [0,0]                                                        ! r: not-a-knot
        bcs_val = 0._dp
        
        ! boundary condition type for each metric element
        bc_ld = [1,2,0,1,0,1]                                                   ! 1: even, 2: odd, 0: zero
        
        ! initialize
        eq%g_E(:,:,:,:,deriv(1),deriv(2),deriv(3)) = 0._dp
        
        if (sum(deriv).eq.0) then                                               ! no derivatives
            ! initialize variables
            allocate(rchi(nchi,grid_eq%loc_n_r),rpsi(nchi,grid_eq%loc_n_r))
            allocate(zchi(nchi,grid_eq%loc_n_r),zpsi(nchi,grid_eq%loc_n_r))
            
            ! normal derivatives
            do id = 1,grid_eq%n(1)
                ierr = spline(grid_eq%loc_r_E,&
                    &r_h(id,grid_eq%i_min:grid_eq%i_max),grid_eq%loc_r_E,&
                    &rpsi(id,:),ord=norm_disc_prec_eq,deriv=1,bcs=bcs(:,3),&
                    &bcs_val=bcs_val(:,3))
                chckerr('')
                ierr = spline(grid_eq%loc_r_E,&
                    &z_h(id,grid_eq%i_min:grid_eq%i_max),grid_eq%loc_r_E,&
                    &zpsi(id,:),ord=norm_disc_prec_eq,deriv=1,bcs=bcs(:,3),&
                    &bcs_val=bcs_val(:,3))
                chckerr('')
            end do
            
            ! poloidal derivatives
            do kd = 1,grid_eq%loc_n_r
                ierr = spline(chi_h,r_h(:,grid_eq%i_min-1+kd),chi_h,&
                    &rchi(:,kd),ord=norm_disc_prec_eq,deriv=1,bcs=bcs(:,1),&
                    &bcs_val=bcs_val(:,1))                                      ! even
                chckerr('')
                ierr = spline(chi_h,z_h(:,grid_eq%i_min-1+kd),chi_h,&
                    &zchi(:,kd),ord=norm_disc_prec_eq,deriv=1,bcs=bcs(:,2),&
                    &bcs_val=bcs_val(:,2))                                      ! odd
                chckerr('')
            end do
            
            ! set up g_H
            do jd = 1,grid_eq%n(2)
                eq%g_E(:,jd,:,c([1,1],.true.),0,0,0) = rpsi*rpsi+zpsi*zpsi
                eq%g_E(:,jd,:,c([1,2],.true.),0,0,0) = rpsi*rchi+zpsi*zchi
                eq%g_E(:,jd,:,c([2,2],.true.),0,0,0) = rpsi*rchi+zpsi*zchi
                eq%g_E(:,jd,:,c([2,2],.true.),0,0,0) = rchi*rchi+zchi*zchi
                eq%g_E(:,jd,:,c([3,3],.true.),0,0,0) = &
                    &1._dp/h_h_33(:,grid_eq%i_min:grid_eq%i_max)
            end do
            
            ! clean up
            deallocate(zchi,rchi,zpsi,rpsi)
        else if (deriv(3).ne.0) then                                            ! axisymmetry: deriv. in tor. coord. is zero
            !eq%g_E(:,:,:,:,deriv(1),deriv(2),deriv(3)) = 0.0_dp
        else if (deriv(1).le.2 .and. deriv(2).le.2) then
            ! initialize 2-D cubic spline for even (1) and odd (2) quantities
            do ld = 1,2
                call ezspline_init(f_spl(ld),grid_eq%n(1),grid_eq%loc_n_r,&
                    &bcs(:,ld),bcs(:,3),ierr) 
                call ezspline_error(ierr)
                chckerr('')
                
                ! set grid
                f_spl(ld)%x1 = chi_h
                f_spl(ld)%x2 = grid_eq%loc_r_E
                
                ! set boundary conditions
                f_spl(ld)%bcval1min = bcs_val(1,ld)
                f_spl(ld)%bcval1max = bcs_val(2,ld)
                f_spl(ld)%bcval2min = bcs_val(1,3)
                f_spl(ld)%bcval2max = bcs_val(2,3)
            end do
            
            do ld = 1,6
                do jd = 1,grid_eq%n(2)
                    if (bc_ld(ld).eq.0) cycle                                   ! quantity is zero
                    
                    ! set up 
                    call ezspline_setup(f_spl(bc_ld(ld)),&
                        &eq%g_E(:,jd,:,ld,0,0,0),ierr,exact_dim=.true.)         ! match exact dimensions, none of them old Fortran bullsh*t!
                    call ezspline_error(ierr)
                    chckerr('')
                    
                    ! derivate
                    ! Note:  deriv  is the  other  way  around because  poloidal
                    ! indices come before normal
                    call ezspline_derivative(f_spl(bc_ld(ld)),deriv(2),&
                        &deriv(1),grid_eq%n(1),grid_eq%loc_n_r,chi_h,&
                        &grid_eq%loc_r_E,eq%g_E(:,jd,:,ld,deriv(1),deriv(2),0),&
                        &ierr) 
                    call ezspline_error(ierr)
                    chckerr('')
                end do
            end do
            
            ! free
            do ld = 1,2
                call ezspline_free(f_spl(ld),ierr)
                call ezspline_error(ierr)
            end do
        else
            ierr = 1
            err_msg = 'Derivative of order ('//trim(i2str(deriv(1)))//','//&
                &trim(i2str(deriv(2)))//','//trim(i2str(deriv(3)))//'&
                &) not supported'
            chckerr(err_msg)
        end if
    end function calc_g_h_ind
    integer function calc_g_h_arr(grid_eq,eq,deriv) result(ierr)
        character(*), parameter :: rout_name = 'calc_g_H_arr'
        
        ! input / output
        type(grid_type), intent(in) :: grid_eq
        type(eq_2_type), intent(inout) :: eq
        integer, intent(in) :: deriv(:,:)
        
        ! local variables
        integer :: id
        
        ! initialize ierr
        ierr = 0
        
        do id = 1, size(deriv,2)
            ierr = calc_g_h_ind(grid_eq,eq,deriv(:,id))
            chckerr('')
        end do
    end function calc_g_h_arr
 
    integer function calc_g_f_ind(eq,deriv) result(ierr)
        use eq_utilities, only: calc_g
        
        character(*), parameter :: rout_name = 'calc_g_F_ind'
        
        ! input / output
        type(eq_2_type), intent(inout) :: eq
        integer, intent(in) :: deriv(:)
        
        ! initialize ierr
        ierr = 0
        
#if ldebug
        ! check the derivatives requested
        ierr = check_deriv(deriv,max_deriv,'calc_g_F')
        chckerr('')
#endif
        
        ! calculate g_F
        ierr = calc_g(eq%g_E,eq%T_FE,eq%g_F,deriv,max_deriv)
        chckerr('')
    end function calc_g_f_ind
    integer function calc_g_f_arr(eq,deriv) result(ierr)
        character(*), parameter :: rout_name = 'calc_g_F_arr'
        
        ! input / output
        type(eq_2_type), intent(inout) :: eq
        integer, intent(in) :: deriv(:,:)
        
        ! local variables
        integer :: id
        
        ! initialize ierr
        ierr = 0
        
        do id = 1, size(deriv,2)
            ierr = calc_g_f_ind(eq,deriv(:,id))
            chckerr('')
        end do
    end function calc_g_f_arr
    
    integer function calc_jac_v_ind(grid,eq,deriv) result(ierr)
        use vmec_utilities, only: fourier2real
        use vmec_vars, only: jac_v_c, jac_v_s, is_asym_v
        
        character(*), parameter :: rout_name = 'calc_jac_V_ind'
        
        ! input / output
        type(grid_type), intent(in) :: grid
        type(eq_2_type), intent(inout) :: eq
        integer, intent(in) :: deriv(:)
        
        ! initialize ierr
        ierr = 0
        
#if ldebug
        ! check the derivatives requested
        ierr = check_deriv(deriv,max_deriv,'calc_J_V')
        chckerr('')
#endif
        
        ! initialize
        eq%jac_E(:,:,:,deriv(1),deriv(2),deriv(3)) = 0.0_dp
        
        ! calculate the Jacobian and its derivatives
        ierr = fourier2real(jac_v_c(:,grid%i_min:grid%i_max,deriv(1)),&
            &jac_v_s(:,grid%i_min:grid%i_max,deriv(1)),grid%trigon_factors,&
            &eq%jac_E(:,:,:,deriv(1),deriv(2),deriv(3)),&
            &sym=[.true.,is_asym_v],deriv=[deriv(2),deriv(3)])
        chckerr('')
    end function calc_jac_v_ind
    integer function calc_jac_v_arr(grid,eq,deriv) result(ierr)
        character(*), parameter :: rout_name = 'calc_jac_V_arr'
        
        ! input / output
        type(grid_type), intent(in) :: grid
        type(eq_2_type), intent(inout) :: eq
        integer, intent(in) :: deriv(:,:)
        
        ! local variables
        integer :: id
        
        ! initialize ierr
        ierr = 0
        
        do id = 1, size(deriv,2)
            ierr = calc_jac_v_ind(grid,eq,deriv(:,id))
            chckerr('')
        end do
    end function calc_jac_v_arr
    
    integer function calc_jac_h_ind(grid_eq,eq_1,eq_2,deriv) result(ierr)
        use helena_vars, only: ias, h_h_33, rbphi_h, chi_h
        use ezspline_obj
        use ezspline
        
        character(*), parameter :: rout_name = 'calc_jac_H_ind'
        
        ! input / output
        type(grid_type), intent(in) :: grid_eq
        type(eq_1_type), intent(in) :: eq_1
        type(eq_2_type), intent(inout) :: eq_2
        integer, intent(in) :: deriv(:)
        
        ! local variables
        character(len=max_str_ln) :: err_msg                                    ! error message
        type(ezspline2_r8) :: f_spl                                             ! spline object for interpolation
        integer :: jd, kd                                                       ! counters
        integer :: bcs(2,2)                                                     ! boundary conditions (theta(even), r)
        real(dp) :: bcs_val(2,2)                                                ! values for boundary conditions
        
        ! initialize ierr
        ierr = 0
        
#if ldebug
        ! check the derivatives requested
        ierr = check_deriv(deriv,max_deriv,'calc_jac_H')
        chckerr('')
#endif
        
        ! set up boundary conditions
        if (ias.eq.0) then                                                      ! top-bottom symmetric
            bcs(:,1) = [1,1]                                                    ! theta(even): zero first derivative
        else
            bcs(:,1) = [-1,-1]                                                  ! periodic
        end if
        bcs(:,2) = [0,0]                                                        ! r: not-a-knot
        bcs_val = 0._dp
        
        ! calculate determinant
        if (sum(deriv).eq.0) then                                               ! no derivatives
            do kd = 1,grid_eq%loc_n_r
                do jd = 1,grid_eq%n(2)
                    eq_2%jac_E(:,jd,kd,0,0,0) = eq_1%q_saf_E(kd,0)/&
                        &(h_h_33(:,grid_eq%i_min-1+kd)*&
                        &rbphi_h(grid_eq%i_min-1+kd,0))
                end do
            end do
        else if (deriv(3).ne.0) then                                            ! axisymmetry: deriv. in tor. coord. is zero
            eq_2%jac_E(:,:,:,deriv(1),deriv(2),deriv(3)) = 0.0_dp
        else if (deriv(1).le.2 .and. deriv(2).le.2) then
            ! initialize 2-D cubic spline
            call ezspline_init(f_spl,grid_eq%n(1),grid_eq%loc_n_r,&
                &bcs(:,1),bcs(:,2),ierr) 
            call ezspline_error(ierr)
            chckerr('')
            
            
            ! set grid
            f_spl%x1 = chi_h
            f_spl%x2 = grid_eq%loc_r_E
            
            ! set boundary conditions
            f_spl%bcval1min = bcs_val(1,1)
            f_spl%bcval1max = bcs_val(2,1)
            f_spl%bcval2min = bcs_val(1,2)
            f_spl%bcval2max = bcs_val(2,2)
            
            do jd = 1,grid_eq%n(2)
                ! set up 
                call ezspline_setup(f_spl,eq_2%jac_E(:,jd,:,0,0,0),ierr,&
                    &exact_dim=.true.)                                          ! match exact dimensions, none of them old Fortran bullsh*t!
                call ezspline_error(ierr)
                chckerr('')
                
                ! derivate
                ! Note: deriv is  the other way around  because poloidal indices
                ! come before normal
                call ezspline_derivative(f_spl,deriv(2),deriv(1),grid_eq%n(1),&
                    &grid_eq%loc_n_r,chi_h,grid_eq%loc_r_E,&
                    &eq_2%jac_E(:,jd,:,deriv(1),deriv(2),0),ierr) 
                call ezspline_error(ierr)
                chckerr('')
            end do
            
            ! free
            call ezspline_free(f_spl,ierr)
            call ezspline_error(ierr)
        else
            ierr = 1
            err_msg = 'Derivative of order ('//trim(i2str(deriv(1)))//','//&
                &trim(i2str(deriv(2)))//','//trim(i2str(deriv(3)))//'&
                &) not supported'
            chckerr(err_msg)
        end if
    end function calc_jac_h_ind
    integer function calc_jac_h_arr(grid_eq,eq_1,eq_2,deriv) result(ierr)
        character(*), parameter :: rout_name = 'calc_jac_H_arr'
        
        ! input / output
        type(grid_type), intent(in) :: grid_eq
        type(eq_1_type), intent(in) :: eq_1
        type(eq_2_type), intent(inout) :: eq_2
        integer, intent(in) :: deriv(:,:)
        
        ! local variables
        integer :: id
        
        ! initialize ierr
        ierr = 0
        
        do id = 1, size(deriv,2)
            ierr = calc_jac_h_ind(grid_eq,eq_1,eq_2,deriv(:,id))
            chckerr('')
        end do
    end function calc_jac_h_arr
    
    integer function calc_jac_f_ind(eq,deriv) result(ierr)
        use num_utilities, only: add_arr_mult
        
        character(*), parameter :: rout_name = 'calc_jac_F_ind'
        
        ! input / output
        type(eq_2_type), intent(inout) :: eq
        integer, intent(in) :: deriv(:)
        
        ! initialize ierr
        ierr = 0
        
#if ldebug
        ! check the derivatives requested
        ierr = check_deriv(deriv,max_deriv,'calc_J_F')
        chckerr('')
#endif
        
        ! initialize
        eq%jac_F(:,:,:,deriv(1),deriv(2),deriv(3)) = 0.0_dp
        
        ! calculate determinant
        ierr = add_arr_mult(eq%jac_E,eq%det_T_FE,&
            &eq%jac_F(:,:,:,deriv(1),deriv(2),deriv(3)),deriv)
        chckerr('')
    end function calc_jac_f_ind
    integer function calc_jac_f_arr(eq,deriv) result(ierr)
        character(*), parameter :: rout_name = 'calc_jac_F_arr'
        
        ! input / output
        type(eq_2_type), intent(inout) :: eq
        integer, intent(in) :: deriv(:,:)
        
        ! local variables
        integer :: id
        
        ! initialize ierr
        ierr = 0
        
        do id = 1, size(deriv,2)
            ierr = calc_jac_f_ind(eq,deriv(:,id))
            chckerr('')
        end do
    end function calc_jac_f_arr
 
    integer function calc_t_vc_ind(eq,deriv) result(ierr)
        use num_utilities, only: add_arr_mult, c
        
        character(*), parameter :: rout_name = 'calc_T_VC_ind'
        
        ! input / output
        type(eq_2_type), intent(inout) :: eq
        integer, intent(in) :: deriv(:)
        
        
        ! initialize ierr
        ierr = 0
#if ldebug
        ! check the derivatives requested
        ierr = check_deriv(deriv,max_deriv,'calc_T_VC')
        chckerr('')
#endif
        
        ! initialize
        eq%T_VC(:,:,:,:,deriv(1),deriv(2),deriv(3)) = 0._dp
        
        ! calculate transformation matrix T_V^C
        eq%T_VC(:,:,:,c([1,1],.false.),deriv(1),deriv(2),deriv(3)) = &
            &eq%R_E(:,:,:,deriv(1)+1,deriv(2),deriv(3))
        !eq%T_VC(:,:,:,c([1,2],.false.),deriv(1),deriv(2),deriv(3)) = 0
        eq%T_VC(:,:,:,c([1,3],.false.),deriv(1),deriv(2),deriv(3)) = &
            &eq%Z_E(:,:,:,deriv(1)+1,deriv(2),deriv(3))
        eq%T_VC(:,:,:,c([2,1],.false.),deriv(1),deriv(2),deriv(3)) = &
            &eq%R_E(:,:,:,deriv(1),deriv(2)+1,deriv(3))
        !eq%T_VC(:,:,:,c([2,2],.false.),deriv(1),deriv(2),deriv(3)) = 0
        eq%T_VC(:,:,:,c([2,3],.false.),deriv(1),deriv(2),deriv(3)) = &
            &eq%Z_E(:,:,:,deriv(1),deriv(2)+1,deriv(3))
        eq%T_VC(:,:,:,c([3,1],.false.),deriv(1),deriv(2),deriv(3)) = &
            &eq%R_E(:,:,:,deriv(1),deriv(2),deriv(3)+1)
        if (sum(deriv).eq.0) then
            eq%T_VC(:,:,:,c([3,2],.false.),deriv(1),deriv(2),deriv(3)) = 1.0_dp
        else
            !eq%T_VC(:,:,:,c([3,2],.false.),deriv(1),deriv(2),deriv(3)) = 0
        end if
        eq%T_VC(:,:,:,c([3,3],.false.),deriv(1),deriv(2),deriv(3)) = &
            &eq%Z_E(:,:,:,deriv(1),deriv(2),deriv(3)+1)
    end function calc_t_vc_ind
    integer function calc_t_vc_arr(eq,deriv) result(ierr)
        character(*), parameter :: rout_name = 'calc_T_VC_arr'
        
        ! input / output
        type(eq_2_type), intent(inout) :: eq
        integer, intent(in) :: deriv(:,:)
        
        ! local variables
        integer :: id
        
        ! initialize ierr
        ierr = 0
        
        do id = 1, size(deriv,2)
            ierr = calc_t_vc_ind(eq,deriv(:,id))
            chckerr('')
        end do
    end function calc_t_vc_arr
 
    integer function calc_t_vf_ind(grid_eq,eq_1,eq_2,deriv) result(ierr)
        use num_vars, only: use_pol_flux_f
        use num_utilities, only: add_arr_mult, c
        
        character(*), parameter :: rout_name = 'calc_T_VF_ind'
        
        ! input / output
        type(grid_type), intent(in) :: grid_eq
        type(eq_1_type), intent(in) :: eq_1
        type(eq_2_type), intent(inout) :: eq_2
        integer, intent(in) :: deriv(:)
        
        ! local variables
        integer :: kd                                                           ! counter
        real(dp), allocatable :: theta_s(:,:,:,:,:,:)                           ! theta_F and derivatives
        real(dp), allocatable :: zeta_s(:,:,:,:,:,:)                            ! - zeta_F and derivatives
        integer :: dims(3)                                                      ! dimensions
        integer :: c1                                                           ! 2D coordinate in met_type storage convention
        
        ! initialize ierr
        ierr = 0
        
#if ldebug
        ! check the derivatives requested
        ierr = check_deriv(deriv,max_deriv,'calc_T_VF')
        chckerr('')
#endif
        
        ! set up dims
        dims = [grid_eq%n(1),grid_eq%n(2),grid_eq%loc_n_r]
        
        ! initialize
        eq_2%T_EF(:,:,:,:,deriv(1),deriv(2),deriv(3)) = 0._dp
        
        ! set up theta_s
        allocate(theta_s(dims(1),dims(2),dims(3),&
            &0:deriv(1)+1,0:deriv(2)+1,0:deriv(3)+1))
        theta_s = 0.0_dp
        ! start from theta_E
        theta_s(:,:,:,0,0,0) = grid_eq%theta_E
        theta_s(:,:,:,0,1,0) = 1.0_dp
        ! add the deformation described by lambda
        theta_s = theta_s + &
            &eq_2%L_E(:,:,:,0:deriv(1)+1,0:deriv(2)+1,0:deriv(3)+1)
            
        if (use_pol_flux_f) then
            ! calculate transformation matrix T_V^F
            ! (1,1)
            ierr = add_arr_mult(theta_s,eq_1%q_saf_E(:,1:),&
                &eq_2%T_EF(:,:,:,c([1,1],.false.),deriv(1),deriv(2),deriv(3)),&
                &deriv)
            chckerr('')
            ierr = add_arr_mult(eq_2%L_E(:,:,:,1:,0:,0:),eq_1%q_saf_E(:,0:),&
                &eq_2%T_EF(:,:,:,c([1,1],.false.),deriv(1),deriv(2),deriv(3)),&
                &deriv)
            chckerr('')
            ! (1,2)
            if (deriv(2).eq.0 .and. deriv(3).eq.0) then
                do kd = 1,dims(3)
                    eq_2%T_EF(:,:,kd,c([1,2],.false.),deriv(1),0,0) = &
                        &eq_1%flux_p_E(kd,deriv(1)+1)/(2*pi)
                end do
            !else
                !eq_2%T_EF(:,:,:,c([1,2],.false.),deriv(1),deriv(2),deriv(3)) &
                    !&= 0.0_dp
            end if
            ! (1,3)
            eq_2%T_EF(:,:,:,c([1,3],.false.),deriv(1),deriv(2),deriv(3)) = &
                &eq_2%L_E(:,:,:,deriv(1)+1,deriv(2),deriv(3))
            ! (2,1)
            ierr = add_arr_mult(theta_s(:,:,:,0:,1:,0:),eq_1%q_saf_E,&
                &eq_2%T_EF(:,:,:,c([2,1],.false.),deriv(1),deriv(2),deriv(3)),&
                &deriv)
            chckerr('')
            ! (2,2)
            !eq_2%T_EF(:,:,:,c([2,2],.false.),deriv(1),deriv(2),deriv(3)) = &
                !&0.0_dp
            ! (2,3)
            eq_2%T_EF(:,:,:,c([2,3],.false.),deriv(1),deriv(2),deriv(3)) = &
                &theta_s(:,:,:,deriv(1),deriv(2)+1,deriv(3))
            ! (3,1)
            if (sum(deriv).eq.0) then
                eq_2%T_EF(:,:,:,c([3,1],.false.),0,0,0) = -1.0_dp
            end if
            ierr = add_arr_mult(eq_2%L_E(:,:,:,0:,0:,1:),eq_1%q_saf_E,&
                &eq_2%T_EF(:,:,:,c([3,1],.false.),deriv(1),deriv(2),deriv(3)),&
                &deriv)
            chckerr('')
            ! (3,2)
            !eq_2%T_EF(:,:,:,c([3,2],.false.),deriv(1),deriv(2),deriv(3)) = &
                !&0.0_dp
            ! (3,3)
            eq_2%T_EF(:,:,:,c([3,3],.false.),deriv(1),deriv(2),deriv(3)) = &
                &eq_2%L_E(:,:,:,deriv(1),deriv(2),deriv(3)+1)
            
            ! determinant
            eq_2%det_T_EF(:,:,:,deriv(1),deriv(2),deriv(3)) = 0.0_dp
            ierr = add_arr_mult(-theta_s(:,:,:,0:,1:,0:),&
                &eq_1%flux_p_E(:,1:)/(2*pi),&
                &eq_2%det_T_EF(:,:,:,deriv(1),deriv(2),deriv(3)),deriv)
            chckerr('')
        else
            ! set up zeta_s
            allocate(zeta_s(dims(1),dims(2),dims(3),0:deriv(1)+1,&
                &0:deriv(2)+1,0:deriv(3)+1))
            zeta_s = 0.0_dp
            ! start from zeta_E
            zeta_s(:,:,:,0,0,0) = grid_eq%zeta_E
            zeta_s(:,:,:,0,0,1) = 1.0_dp
            
            ! calculate transformation matrix T_V^F
            ! (1,1)
            eq_2%T_EF(:,:,:,c([1,1],.false.),deriv(1),deriv(2),deriv(3)) = &
                &-theta_s(:,:,:,deriv(1)+1,deriv(2),deriv(3))
            ierr = add_arr_mult(zeta_s,eq_1%rot_t_E(:,1:),&
                &eq_2%T_EF(:,:,:,c([1,1],.false.),deriv(1),deriv(2),deriv(3)),&
                &deriv)
            chckerr('')
            ! (1,2)
            if (deriv(2).eq.0 .and. deriv(3).eq.0) then
                do kd = 1,dims(3)
                    eq_2%T_EF(:,:,kd,c([1,2],.false.),deriv(1),0,0) = &
                        &-eq_1%flux_t_E(kd,deriv(1)+1)/(2*pi)
                end do
            !else
                !eq_2%T_EF(:,:,:,c([1,2],.false.),deriv(1),deriv(2),deriv(3)) 7
                    !&= 0.0_dp
            end if
            ! (1,3)
            !eq_2%T_EF(:,:,:,c([1,3],.false.),deriv(1),deriv(2),deriv(3)) = &
                !&0.0_dp
            ! (2,1)
            eq_2%T_EF(:,:,:,c([2,1],.false.),deriv(1),deriv(2),deriv(3)) = &
                &-theta_s(:,:,:,deriv(1),deriv(2)+1,deriv(3))
            ! (2,2)
            !eq_2%T_EF(:,:,:,c([2,2],.false.),deriv(1),deriv(2),deriv(3)) = &
                !&0.0_dp
            ! (2,3)
            !eq_2%T_EF(:,:,:,c([2,3],.false.),deriv(1),deriv(2),deriv(3)) = &
                !&0.0_dp
            ! (3,1)
            if (deriv(2).eq.0 .and. deriv(3).eq.0) then
                do kd = 1,dims(3)
                    eq_2%T_EF(:,:,kd,c([3,1],.false.),deriv(1),0,0) = &
                        &eq_1%rot_t_E(kd,deriv(1))
                end do
            end if
            c1 = c([3,1],.false.)                                               ! to avoid compiler crash (as of 26-02-2015)
            eq_2%T_EF(:,:,:,c1,deriv(1),deriv(2),deriv(3)) = &
                &eq_2%T_EF(:,:,:,c1,deriv(1),deriv(2),deriv(3)) &
                &-theta_s(:,:,:,deriv(1),deriv(2),deriv(3)+1)
            ! (3,2)
            !eq_2%T_EF(:,:,:,c([3,2],.false.),deriv(1),deriv(2),deriv(3)) = &
                !&0.0_dp
            ! (3,3)
            if (sum(deriv).eq.0) then
                eq_2%T_EF(:,:,:,c([3,3],.false.),0,0,0) = -1.0_dp
            !else
                !eq_2%T_EF(:,:,:,c([3,3],.false.)deriv(1),deriv(2),deriv(3)) = &
                    !&0.0_dp
            end if
            
            ! determinant
            eq_2%det_T_EF(:,:,:,deriv(1),deriv(2),deriv(3)) = 0.0_dp
            ierr = add_arr_mult(theta_s(:,:,:,0:,1:,0:),&
                &eq_1%flux_t_E(:,1:)/(2*pi),&
                &eq_2%det_T_EF(:,:,:,deriv(1),deriv(2),deriv(3)),deriv)
            chckerr('')
        end if
    end function calc_t_vf_ind
    integer function calc_t_vf_arr(grid_eq,eq_1,eq_2,deriv) result(ierr)
        character(*), parameter :: rout_name = 'calc_T_VF_arr'
        
        ! input / output
        type(grid_type), intent(in) :: grid_eq
        type(eq_1_type), intent(in) :: eq_1
        type(eq_2_type), intent(inout) :: eq_2
        integer, intent(in) :: deriv(:,:)
        
        ! local variables
        integer :: id
        
        ! initialize ierr
        ierr = 0
        
        do id = 1, size(deriv,2)
            ierr = calc_t_vf_ind(grid_eq,eq_1,eq_2,deriv(:,id))
            chckerr('')
        end do
    end function calc_t_vf_arr
    
    integer function calc_t_hf_ind(grid_eq,eq_1,eq_2,deriv) result(ierr)
        use num_vars, only: use_pol_flux_f
        use num_utilities, only: add_arr_mult, c
        
        character(*), parameter :: rout_name = 'calc_T_HF_ind'
        
        ! input / output
        type(grid_type), intent(in) :: grid_eq
        type(eq_1_type), intent(in) :: eq_1
        type(eq_2_type), intent(inout) :: eq_2
        integer, intent(in) :: deriv(:)
        
        ! local variables
        integer :: kd                                                           ! counter
        real(dp), allocatable :: theta_s(:,:,:,:,:,:)                           ! theta_F and derivatives
        real(dp), allocatable :: zeta_s(:,:,:,:,:,:)                            ! - zeta_F and derivatives
        integer :: dims(3)                                                      ! dimensions
        
        ! initialize ierr
        ierr = 0
        
#if ldebug
        ! check the derivatives requested
        ierr = check_deriv(deriv,max_deriv,'calc_T_HF')
        chckerr('')
#endif
        
        ! set up dims
        dims = [grid_eq%n(1),grid_eq%n(2),grid_eq%loc_n_r]
        
        ! initialize
        eq_2%T_EF(:,:,:,:,deriv(1),deriv(2),deriv(3)) = 0._dp
        
        ! set up theta_s
        allocate(theta_s(dims(1),dims(2),dims(3),&
            &0:deriv(1)+1,0:deriv(2)+1,0:deriv(3)+1))
        theta_s = 0.0_dp
        theta_s(:,:,:,0,0,0) = grid_eq%theta_E
        theta_s(:,:,:,0,1,0) = 1.0_dp
            
        if (use_pol_flux_f) then
            ! calculate transformation matrix T_H^F
            ! (1,1)
            ierr = add_arr_mult(theta_s,-eq_1%q_saf_E(:,1:),&
                &eq_2%T_EF(:,:,:,c([1,1],.false.),deriv(1),deriv(2),deriv(3)),&
                &deriv)
            chckerr('')
            ! (1,2)
            if (sum(deriv).eq.0) then
                eq_2%T_EF(:,:,:,c([1,2],.false.),0,0,0) = 1._dp
            !else
                !eq_2%T_EF(:,:,:,c([1,2],.false.),deriv(1),deriv(2),deriv(3)) &
                    !&= 0.0_dp
            end if
            ! (1,3)
            !eq_2%T_EF(:,:,:,c([1,3],.false.),deriv(1),deriv(2),deriv(3)) = &
                !&0.0_dp
            ! (2,1)
            if (deriv(2).eq.0 .and. deriv(3).eq.0) then
                do kd = 1,dims(3)
                    eq_2%T_EF(:,:,kd,c([2,1],.false.),deriv(1),0,0) = &
                        &-eq_1%q_saf_E(kd,deriv(1))
                end do
            !else
                !eq_2%T_EF(:,:,:,c([2,1],.false.),deriv(1),deriv(2),deriv(3)) &
                    !&= 0.0_dp
            end if
            ! (2,2)
            !eq_2%T_EF(:,:,:,c([2,2],.false.),deriv(1),deriv(2),deriv(3)) = &
                !&0.0_dp
            ! (2,3)
            if (sum(deriv).eq.0) then
                eq_2%T_EF(:,:,:,c([2,3],.false.),0,0,0) = 1.0_dp
            !else
                !eq_2%T_EF(:,:,:,c([2,3],.false.),deriv(1),deriv(2),deriv(3)) &
                    !&= 0.0_dp
            end if
            ! (3,1)
            if (sum(deriv).eq.0) then
                eq_2%T_EF(:,:,:,c([3,1],.false.),0,0,0) = 1.0_dp
            !else
                !eq_2%T_EF(:,:,:,c([3,1],.false.),deriv(1),deriv(2),deriv(3)) &
                    !&= 0.0_dp
            end if
            ! (3,2)
            !eq_2%T_EF(:,:,:,c([3,2],.false),deriv(1),deriv(2),deriv(3)) = &
                !&0.0_dp
            ! (3,3)
            !eq_2%T_EF(:,:,:,c([3,3],.false),deriv(1),deriv(2),deriv(3)) = &
                !&0.0_dp
            
            ! determinant
            eq_2%det_T_EF(:,:,:,deriv(1),deriv(2),deriv(3)) = 0.0_dp
            if (sum(deriv).eq.0) then
                eq_2%det_T_EF(:,:,:,deriv(1),0,0) = 1._dp
            !else
                !eq_2%det_T_EF(:,:,deriv(1),deriv(2),deriv(3)) = 0.0_dp
            end if
        else
            ! set up zeta_s
            allocate(zeta_s(dims(1),dims(2),dims(3),&
                &0:deriv(1)+1,0:deriv(2)+1,0:deriv(3)+1))
            zeta_s = 0.0_dp
            ! start from zeta_E
            zeta_s(:,:,:,0,0,0) = grid_eq%zeta_E
            zeta_s(:,:,:,0,0,1) = 1.0_dp
            
            ! calculate transformation matrix T_H^F
            ! (1,1)
            ierr = add_arr_mult(zeta_s,eq_1%rot_t_E(:,1:),&
                &eq_2%T_EF(:,:,:,c([1,1],.false.),deriv(1),deriv(2),deriv(3)),&
                &deriv)
            chckerr('')
            ! (1,2)
            if (deriv(2).eq.0 .and. deriv(3).eq.0) then
                do kd = 1,dims(3)
                    eq_2%T_EF(:,:,kd,c([1,2],.false.),deriv(1),0,0) = &
                        &eq_1%q_saf_E(kd,deriv(1))
                end do
            !else
                !eq_2%T_EF(:,:,:,c([1,2],.false.),deriv(1),deriv(2),deriv(3)) &
                    !&= 0.0_dp
            end if
            ! (1,3)
            !eq_2%T_EF(:,:,:,c([1,3],.false.),deriv(1),deriv(2),deriv(3)) = &
                !&0.0_dp
            ! (2,1)
            if (sum(deriv).eq.0) then
                eq_2%T_EF(:,:,:,c([2,1],.false.),0,0,0) = -1.0_dp
            !else
                !eq_2%T_EF(:,:,:,c([2,1],.false.),deriv(1),deriv(2),deriv(3)) &
                    !&= 0.0_dp
            end if
            ! (2,2)
            !eq_2%T_EF(:,:,:,c([2,2],.false.),deriv(1),deriv(2),deriv(3)) = &
                !&0.0_dp
            ! (2,3)
            !eq_2%T_EF(:,:,:,c([2,3],.false.),deriv(1),deriv(2),deriv(3)) = &
                !&0.0_dp
            ! (3,1)
            if (deriv(2).eq.0 .and. deriv(3).eq.0) then
                do kd = 1,dims(3)
                    eq_2%T_EF(:,:,kd,c([3,1],.false.),deriv(1),0,0) = &
                        &eq_1%rot_t_E(kd,deriv(1))
                end do
            !else
                !eq_2%T_EF(:,:,:,c([3,1],.false.),deriv(1),deriv(2),deriv(3)) &
                    !&= 0.0_dp
            end if
            ! (3,2)
            !eq_2%T_EF(:,:,:,c([3,2],.false.),deriv(1),deriv(2),deriv(3)) = &
                !&0.0_dp
            ! (3,3)
            if (sum(deriv).eq.0) then
                eq_2%T_EF(:,:,:,c([3,3],.false.),deriv(1),0,0) = 1.0_dp
            !else
                !eq_2%T_EF(:,:,:,c([3,3],.false.),deriv(1),deriv(2),deriv(3)) &
                    !&= 0.0_dp
            end if
            
            ! determinant
            eq_2%det_T_EF(:,:,:,deriv(1),deriv(2),deriv(3)) = 0.0_dp
            if (deriv(2).eq.0 .and. deriv(3).eq.0) then
                do kd = 1,dims(3)
                    eq_2%det_T_EF(:,:,kd,deriv(1),0,0) = &
                        &eq_1%q_saf_E(kd,deriv(1))
                end do
            !else
                !eq_2%det_T_EF(:,:,deriv(1),deriv(2),deriv(3)) = 0.0_dp
            end if
        end if
    end function calc_t_hf_ind
    integer function calc_t_hf_arr(grid_eq,eq_1,eq_2,deriv) result(ierr)
        character(*), parameter :: rout_name = 'calc_T_HF_arr'
        
        ! input / output
        type(grid_type), intent(in) :: grid_eq
        type(eq_1_type), intent(in) :: eq_1
        type(eq_2_type), intent(inout) :: eq_2
        integer, intent(in) :: deriv(:,:)
        
        ! local variables
        integer :: id
        
        ! initialize ierr
        ierr = 0
        
        do id = 1, size(deriv,2)
            ierr = calc_t_hf_ind(grid_eq,eq_1,eq_2,deriv(:,id))
            chckerr('')
        end do
    end function calc_t_hf_arr
 
    integer function flux_q_plot(grid_eq,eq) result(ierr)
        use num_vars, only: rank, no_plots, use_normalization
        use grid_utilities, only: trim_grid
        use mpi_utilities, only: get_ser_var
        use eq_vars, only: pres_0, psi_0
        
        character(*), parameter :: rout_name = 'flux_q_plot'
        
        ! input / output
        type(grid_type), intent(in) :: grid_eq
        type(eq_1_type), intent(in) :: eq
        
        ! local variables
        integer :: norm_id(2)                                                   ! untrimmed normal indices for trimmed grids
        integer :: id                                                           ! counter
        integer :: n_vars = 5                                                   ! nr. of variables to plot
        character(len=max_str_ln), allocatable :: plot_titles(:)                ! plot titles
        type(grid_type) :: grid_trim                                            ! trimmed grid
        real(dp), allocatable :: x_plot_2d(:,:)                                 ! x values of 2D plot
        real(dp), allocatable :: y_plot_2d(:,:)                                 ! y values of 2D plot
        
        ! initialize ierr
        ierr = 0
        
        ! bypass plots if no_plots
        if (no_plots) return
        
        ! user output
        call writo('Plotting flux quantities')
        
        call lvl_ud(1)
        
        ! trim grid
        ierr = trim_grid(grid_eq,grid_trim,norm_id)
        chckerr('')
        
        ! initialize plot titles and file names
        allocate(plot_titles(n_vars))
        plot_titles(1) = 'safety factor []'
        plot_titles(2) = 'rotational transform []'
        plot_titles(3) = 'pressure [pa]'
        plot_titles(4) = 'poloidal flux [Tm^2]'
        plot_titles(5) = 'toroidal flux [Tm^2]'
        
        ! plot using HDF5
        ierr = flux_q_plot_hdf5()
        chckerr('')
        
        ! plot using external program
        ierr = flux_q_plot_ex()
        chckerr('')
        
        ! clean up
        call grid_trim%dealloc()
        
        call lvl_ud(-1)
    contains
        ! plots the flux quantities in HDF5
        integer function flux_q_plot_hdf5() result(ierr)
            use num_vars, only: eq_style
            use output_ops, only: plot_hdf5
            use grid_utilities, only: extend_grid_f, trim_grid, calc_xyz_grid
            use vmec_utilities, only: calc_trigon_factors
            
            character(*), parameter :: rout_name = 'flux_q_plot_HDF5'
            
            ! local variables
            integer :: kd                                                       ! counter
            real(dp), allocatable :: x_plot(:,:,:,:)                            ! x values of total plot
            real(dp), allocatable :: y_plot(:,:,:,:)                            ! y values of total plot
            real(dp), allocatable :: z_plot(:,:,:,:)                            ! z values of total plot
            real(dp), allocatable :: f_plot(:,:,:,:)                            ! values of variable of total plot
            integer :: plot_dim(4)                                              ! total plot dimensions
            integer :: plot_offset(4)                                           ! plot offset
            type(grid_type) :: grid_plot                                        ! grid for plotting
            character(len=max_str_ln) :: file_name                              ! file name
            
            ! initialize ierr
            ierr = 0
            
            ! set up file name
            file_name = 'flux_quantities'
            
            ! fill the 2D version of the plot
            allocate(y_plot_2d(grid_trim%loc_n_r,n_vars))
            
            y_plot_2d(:,1) = eq%q_saf_FD(norm_id(1):norm_id(2),0)
            y_plot_2d(:,2) = eq%rot_t_FD(norm_id(1):norm_id(2),0)
            y_plot_2d(:,3) = eq%pres_FD(norm_id(1):norm_id(2),0)
            y_plot_2d(:,4) = eq%flux_p_FD(norm_id(1):norm_id(2),0)
            y_plot_2d(:,5) = eq%flux_t_FD(norm_id(1):norm_id(2),0)
            
            ! extend trimmed equilibrium grid
            ierr = extend_grid_f(grid_trim,grid_plot,grid_eq=grid_eq)
            chckerr('')
            
            ! if VMEC, calculate trigonometric factors of plot grid
            if (eq_style.eq.1) then
                ierr = calc_trigon_factors(grid_plot%theta_E,grid_plot%zeta_E,&
                    &grid_plot%trigon_factors)
                chckerr('')
            end if
            
            ! set up plot_dim and plot_offset
            plot_dim = [grid_plot%n(1),grid_plot%n(2),grid_plot%n(3),n_vars]
            plot_offset = [0,0,grid_plot%i_min-1,n_vars]
            
            ! set up total plot variables
            allocate(x_plot(grid_plot%n(1),grid_plot%n(2),grid_plot%loc_n_r,&
                &n_vars))
            allocate(y_plot(grid_plot%n(1),grid_plot%n(2),grid_plot%loc_n_r,&
                &n_vars))
            allocate(z_plot(grid_plot%n(1),grid_plot%n(2),grid_plot%loc_n_r,&
                &n_vars))
            allocate(f_plot(grid_plot%n(1),grid_plot%n(2),grid_plot%loc_n_r,&
                &n_vars))
            
            ! calculate 3D X,Y and Z
            ierr = calc_xyz_grid(grid_eq,grid_plot,x_plot(:,:,:,1),&
                &y_plot(:,:,:,1),z_plot(:,:,:,1))
            chckerr('')
            do id = 2,n_vars
                x_plot(:,:,:,id) = x_plot(:,:,:,1)
                y_plot(:,:,:,id) = y_plot(:,:,:,1)
                z_plot(:,:,:,id) = z_plot(:,:,:,1)
            end do
            
            do kd = 1,grid_plot%loc_n_r
                f_plot(:,:,kd,1) = y_plot_2d(kd,1)                              ! safey factor
                f_plot(:,:,kd,2) = y_plot_2d(kd,2)                              ! rotational transform
                f_plot(:,:,kd,3) = y_plot_2d(kd,3)                              ! pressure
                f_plot(:,:,kd,4) = y_plot_2d(kd,4)                              ! poloidal flux
                f_plot(:,:,kd,5) = y_plot_2d(kd,5)                              ! toroidal flux
            end do
            
            ! rescale if normalized
            if (use_normalization) then
                f_plot(:,:,:,3) = f_plot(:,:,:,3)*pres_0                        ! pressure
                f_plot(:,:,:,4) = f_plot(:,:,:,4)*psi_0                         ! flux_p
                f_plot(:,:,:,5) = f_plot(:,:,:,5)*psi_0                         ! flux_t
            end if
            
            ! print the output using HDF5
            call plot_hdf5(plot_titles,file_name,f_plot,plot_dim,plot_offset,&
                &x_plot,y_plot,z_plot,col=1,descr='Flux quantities')
            
            ! deallocate and destroy grid
            deallocate(y_plot_2d)
            deallocate(x_plot,y_plot,z_plot,f_plot)
            call grid_plot%dealloc()
        end function flux_q_plot_hdf5
        
        ! plots the pressure and fluxes in external program
        integer function flux_q_plot_ex() result(ierr)
            use eq_vars, only: max_flux_f
            
            character(*), parameter :: rout_name = 'flux_q_plot_ex'
            
            ! local variables
            character(len=max_str_ln), allocatable :: file_name(:)              ! file_name
            real(dp), allocatable :: ser_var_loc(:)                             ! local serial var
            
            ! initialize ierr
            ierr = 0
            
            ! allocate variabels if master
            if (rank.eq.0) then
                allocate(x_plot_2d(grid_trim%n(3),n_vars))
                allocate(y_plot_2d(grid_trim%n(3),n_vars))
            end if
            
            ! fill the 2D version of the plot
            !ierr = get_ser_var(eq%q_saf_FD(norm_id(1):norm_id(2),0),ser_var_loc)
            !CHCKERR('')
            !if (rank.eq.0) Y_plot_2D(:,1) = ser_var_loc
            !ierr = get_ser_var(eq%rot_t_FD(norm_id(1):norm_id(2),0),ser_var_loc)
            !CHCKERR('')
            !if (rank.eq.0) Y_plot_2D(:,2) = ser_var_loc
            ierr = get_ser_var(eq%pres_FD(norm_id(1):norm_id(2),0),ser_var_loc)
            chckerr('')
            if (rank.eq.0) y_plot_2d(:,3) = ser_var_loc
            ierr = get_ser_var(eq%flux_p_FD(norm_id(1):norm_id(2),0),&
                &ser_var_loc)
            chckerr('')
            if (rank.eq.0) y_plot_2d(:,4) = ser_var_loc
            ierr = get_ser_var(eq%flux_t_FD(norm_id(1):norm_id(2),0),&
                &ser_var_loc)
            chckerr('')
            if (rank.eq.0) y_plot_2d(:,5) = ser_var_loc
            
            ! rescale if normalized
            if (use_normalization .and. rank.eq.0) then
                y_plot_2d(:,3) = y_plot_2d(:,3)*pres_0                          ! pressure
                y_plot_2d(:,4) = y_plot_2d(:,4)*psi_0                           ! flux_p
                y_plot_2d(:,5) = y_plot_2d(:,5)*psi_0                           ! flux_t
            end if
            
            ! continue the plot if master
            if (rank.eq.0) then
                ! deallocate local serial variables
                deallocate(ser_var_loc)
                
                ! set up file names
                allocate(file_name(2))
                file_name(1) = 'pres'
                file_name(2) = 'flux'
                
                ! 2D normal variable (normalized F coordinate)
                x_plot_2d(:,1) = grid_trim%r_F*2*pi/max_flux_f
                do id = 2,n_vars
                    x_plot_2d(:,id) = x_plot_2d(:,1)
                end do
                
                ! plot the  individual 2D output  of this process  (except q_saf
                ! and rot_t, as they are already in plot_resonance)
                call print_ex_2d(plot_titles(3),file_name(1),&
                    &y_plot_2d(:,3),x_plot_2d(:,3),draw=.false.)
                ! fluxes
                call print_ex_2d(plot_titles(4:5),file_name(2),&
                    &y_plot_2d(:,4:5),x_plot_2d(:,4:5),draw=.false.)
                
                ! draw plot
                call draw_ex(plot_titles(3:3),file_name(1),1,1,.false.)         ! pressure
                call draw_ex(plot_titles(4:5),file_name(2),2,1,.false.)         ! fluxes
                
                ! user output
                call writo('Safety factor and rotational transform are plotted &
                    &using "plot_resonance"')
                
                ! clean up
                deallocate(x_plot_2d,y_plot_2d)
            end if
        end function flux_q_plot_ex
    end function flux_q_plot
    
    integer function calc_derived_q(grid_eq,eq_1,eq_2) result(ierr)
        use eq_vars, only: vac_perm, max_flux_f
        use num_vars, only: eq_style, use_pol_flux_f
        use helena_vars, only: r_h, z_h, chi_h, ias
        use num_utilities, only: spline
        
        character(*), parameter :: rout_name = 'calc_derived_q'
        
        ! input / output
        type(grid_type), intent(in) :: grid_eq
        type(eq_1_type), intent(in) :: eq_1
        type(eq_2_type), intent(inout), target :: eq_2
        
        ! local variables
        integer :: id, jd, kd, ld                                               ! counters
        integer :: kd_h                                                         ! kd in Helena tables
        integer :: bcs(2,2)                                                     ! boundary conditions (theta(even), theta(odd))
        real(dp) :: bcs_val(2,2)                                                ! values for boundary conditions
        real(dp), allocatable :: d1_epar(:,:,:,:)                               ! cylindrical contravariant components of alpha derivative of parallel basis vector
        real(dp), allocatable :: d3_epar(:,:,:,:)                               ! cylindrical contravariant components of theta derivative of parallel basis vector
        real(dp), allocatable :: b_n(:,:,:,:)                                   ! covariant Cylindrical components of normal basis vector
        real(dp), allocatable :: b_g(:,:,:,:)                                   ! covariant Cylindrical components of geodesic basis vector
        real(dp), allocatable :: de(:,:,:,:,:,:)                                ! derivs of cov. unit vector in E (space,deriv.,unitvec,output)
        real(dp), allocatable :: d_de(:,:,:,:,:)                                ! derivs of transf. matrix in E (space,deriv.,output)
        real(dp), allocatable :: rchi(:,:,:)                                    ! chi and chi^2 derivatives of R
        real(dp), allocatable :: zchi(:,:,:)                                    ! chi and chi^2 derivatives of Z
        
        ! initialize ierr
        ierr = 0
        
        ! user output
        call writo('Set up derived quantities in flux coordinates')
        
        call lvl_ud(1)
        
        ! initialize helper variables
        allocate(de(grid_eq%n(1),grid_eq%n(2),grid_eq%loc_n_r,2,2,3))
        allocate(d_de(grid_eq%n(1),grid_eq%n(2),grid_eq%loc_n_r,2,3))
        allocate(b_n(grid_eq%n(1),grid_eq%n(2),grid_eq%loc_n_r,3))
        allocate(b_g(grid_eq%n(1),grid_eq%n(2),grid_eq%loc_n_r,3))
        allocate(d1_epar(grid_eq%n(1),grid_eq%n(2),grid_eq%loc_n_r,3))
        allocate(d3_epar(grid_eq%n(1),grid_eq%n(2),grid_eq%loc_n_r,3))
        
        select case (eq_style)
            case (1)                                                            ! VMEC
                ! Calculate the shear S
                call calc_derived_s_direct(eq_2,eq_2%S)
                
                ! Equilibrium contravariant components of angular derivatives of
                ! covariant parallel basis vector
                call calc_derived_de_epar_vmec(grid_eq,eq_2,de,d_de,b_n,b_g)
            case (2)                                                            ! HELENA
                ! Calculate parallel current sigma
                call calc_derived_sigma_hel(grid_eq,eq_2,eq_2%sigma)
                
                ! set up boundary conditions for theta derivatives
                if (ias.eq.0) then                                              ! top-bottom symmetric
                    bcs(:,1) = [1,1]                                            ! theta(even): zero first derivative
                    bcs(:,2) = [2,2]                                            ! theta(odd): zero first derivative
                else
                    bcs(:,1) = [-1,-1]                                          ! theta(even): periodic
                    bcs(:,2) = [-1,-1]                                          ! theta(odd): periodic
                end if
                bcs_val = 0._dp
                
                ! initialize output
                de = 0._dp
                d_de = 0._dp
                b_n = 0._dp
                b_g = 0._dp
                
                ! calculate  the  derivatives  of   covariant  unit  vectors  in
                ! cEquilibrium oordinates
                allocate(rchi(grid_eq%n(1),grid_eq%loc_n_r,0:2))
                allocate(zchi(grid_eq%n(1),grid_eq%loc_n_r,0:2))
                rchi(:,:,0) = r_h(:,grid_eq%i_min:grid_eq%i_max)
                zchi(:,:,0) = z_h(:,grid_eq%i_min:grid_eq%i_max)
                do kd = 1,grid_eq%loc_n_r
                    kd_h = grid_eq%i_min-1+kd
                    do id = 1,2
                        ierr = spline(chi_h,r_h(:,kd_h),chi_h,rchi(:,kd,id),&
                            &ord=3,deriv=id,bcs=bcs(:,1),bcs_val=bcs_val(:,1))  ! even
                        chckerr('')
                        ierr = spline(chi_h,z_h(:,kd_h),chi_h,zchi(:,kd,id),&
                            &ord=3,deriv=id,bcs=bcs(:,2),bcs_val=bcs_val(:,2))  ! odd
                        chckerr('')
                    end do
                end do
                
                ! Equilibrium contravariant components of angular derivatives of
                ! covariant parallel basis vector
                call calc_derived_de_epar_hel(grid_eq,eq_1,rchi,zchi,&
                    &de,d_de,b_n,b_g)
        end select
        
        ! calculate cylindrical contravariant  components of angular derivatives
        ! of covariant parallel basis vector
        call calc_derived_dc_epar(de,d_de,eq_2%T_FE(:,:,:,:,0,0,0),&
            &d1_epar,d3_epar)
        
        ! clean up
        deallocate(de,d_de)
        
        ! calculate normal and geodesic curvature
        call calc_derived_kappa_from_e(grid_eq,eq_1,eq_2,b_n,b_g,&
            eq_2%kappa_n,eq_2%kappa_g)
        
        select case (eq_style)
            case (1)                                                            ! VMEC
                ! calculate parallel current
                call calc_derived_sigma_from_e(eq_2,b_n,eq_2%sigma)
            case (2)                                                            ! HELENA
                ! Calculate the shear S
                ierr = calc_derived_s_from_deriv_hel(grid_eq,eq_2,bcs(:,1),&
                    &bcs_val(:,1),eq_2%S)                                       ! even
                chckerr('')
        end select
        
        ! clean up
        deallocate(b_n,b_g)
        
#if ldebug
        if (debug_calc_derived_q) then
            ! plot them
            ierr = plot_derived_q(grid_eq,eq_2)
            chckerr('')
            
            call writo('Testing consistency of derived quantities')
            call lvl_ud(1)
            
            ! test consistency sigma and kappa_g
            ierr = test_sigma_with_kappa_g(grid_eq,eq_1,eq_2)
            chckerr('')
            
            ! test comparison with naive implementations
            ierr = test_kappa(grid_eq,eq_1,eq_2)
            chckerr('')
            select case (eq_style)
                case (1)                                                        ! VMEC
                    ierr = test_sigma_vmec(grid_eq,eq_1,eq_2)
                    chckerr('')
                case (2)                                                        ! HELENA
                    call test_s_hel(grid_eq,eq_2,rchi,zchi)
            end select
            
            call lvl_ud(-1)
            call writo('Testing done')
        end if
#endif
        
        call lvl_ud(-1)
    contains
        subroutine calc_derived_s_direct(eq_2,S)
            use num_utilities, only: c
            use num_vars, only: tol_zero
            
            ! input / output
            type(eq_2_type), intent(in), target :: eq_2
            real(dp), intent(out) :: s(:,:,:)
            
            ! local variables
            real(dp), pointer :: j(:,:,:) => null()                             ! jac
            real(dp), pointer :: h12(:,:,:) => null()                           ! h^alpha,psi
            real(dp), pointer :: d3h12(:,:,:) => null()                         ! D_theta h^alpha,psi
            real(dp), pointer :: h22(:,:,:) => null()                           ! h^psi,psi
            real(dp), pointer :: d3h22(:,:,:) => null()                         ! D_theta h^psi,psi
            real(dp), allocatable :: h22_corrected(:,:,:)                       ! to avoid division by zero
            
            ! set up submatrices
            j => eq_2%jac_FD(:,:,:,0,0,0)
            h12 => eq_2%h_FD(:,:,:,c([1,2],.true.),0,0,0)
            d3h12 => eq_2%h_FD(:,:,:,c([1,2],.true.),0,0,1)
            h22 => eq_2%h_FD(:,:,:,c([2,2],.true.),0,0,0)
            d3h22 => eq_2%h_FD(:,:,:,c([2,2],.true.),0,0,1)
            allocate(h22_corrected(size(s,1),size(s,2),size(s,3)))
            h22_corrected = sign(max(abs(h22),tol_zero),h22)
            
            ! Calculate the shear S
            s = -(d3h12/h22_corrected - d3h22*h12/h22_corrected**2)/j
            
            ! clean up
            nullify(j,h12,d3h12,h22,d3h22)
        end subroutine calc_derived_s_direct
        
        integer function calc_derived_s_from_deriv_hel(grid_eq,eq_2,bcs,&
            &bcs_val,S) result(ierr)
            
            use num_utilities, only: c, spline
            use helena_vars, only: chi_h
            
            character(*), parameter :: rout_name = &
                &'calc_derived_S_from_deriv_HEL'
            
            ! input / output
            type(grid_type), intent(in) :: grid_eq
            type(eq_2_type), intent(in), target :: eq_2
            integer :: bcs(2)
            real(dp) :: bcs_val(2)
            real(dp), intent(out) :: s(:,:,:)
            
            ! local variables
            integer :: jd, kd                                                   ! counters
            real(dp), pointer :: j(:,:,:) => null()                             ! jac
            real(dp), pointer :: h12(:,:,:) => null()                           ! h^alpha,psi
            real(dp), pointer :: h22(:,:,:) => null()                           ! h^psi,psi
            
            ! initialize ierr
            ierr = 0
            
            ! set up submatrices
            j => eq_2%jac_FD(:,:,:,0,0,0)
            h12 => eq_2%h_FD(:,:,:,c([1,2],.true.),0,0,0)
            h22 => eq_2%h_FD(:,:,:,c([2,2],.true.),0,0,0)
            
            ! Calculate the shear S
            do kd = 1,grid_eq%loc_n_r
                do jd = 1,grid_eq%n(2)
                    ierr = spline(chi_h,h12(:,jd,kd)/h22(:,jd,kd),chi_h,&
                        &s(:,jd,kd),ord=3,deriv=1,bcs=bcs,bcs_val=bcs_val)
                    chckerr('')
                end do
            end do
            s = -s/j
            
            ! clean up
            nullify(j,h12,h22)
        end function calc_derived_s_from_deriv_hel
        
        subroutine calc_derived_s_from_sigma_hel(grid_eq,eq_2,Rchi,Zchi,S)
            use num_utilities, only: c
            use helena_vars, only: rbphi_h
            
            ! input / output
            type(grid_type), intent(in) :: grid_eq
            type(eq_2_type), intent(in), target :: eq_2
            real(dp), intent(in) :: rchi(:,:,0:)
            real(dp), intent(in) :: zchi(:,:,0:)
            real(dp), intent(out) :: s(:,:,:)
            
            ! local variables
            integer :: jd, kd                                                   ! counters
            integer :: kd_h                                                     ! kd in Helena tables
            real(dp), allocatable :: k(:,:,:)                                   ! RHS
            real(dp), pointer :: j(:,:,:) => null()                             ! jac
            real(dp), pointer :: g33(:,:,:) => null()                           ! g^theta,theta
            real(dp), pointer :: h22(:,:,:) => null()                           ! h^psi,psi
            
            ! set up submatrices
            j => eq_2%jac_FD(:,:,:,0,0,0)
            g33 => eq_2%g_FD(:,:,:,c([3,3],.true.),0,0,0)
            h22 => eq_2%h_FD(:,:,:,c([2,2],.true.),0,0,0)
            
            ! set up RHS K
            allocate(k(grid_eq%n(1),grid_eq%n(2),grid_eq%loc_n_r))
            do jd = 1,grid_eq%n(2)
                k(:,jd,:) = zchi(:,:,1)/rchi(:,:,0) + &
                    &(zchi(:,:,1)*rchi(:,:,2)-rchi(:,:,1)*zchi(:,:,2))/&
                    &(rchi(:,:,1)**2+zchi(:,:,1)**2)
                do kd = 1,grid_eq%loc_n_r
                    kd_h = grid_eq%i_min-1+kd
                    k(:,jd,kd) = -2._dp*rbphi_h(kd_h,0)/rchi(:,kd,0) * &
                        &k(:,jd,kd)
                end do
            end do
            
            ! subtract mu_0 J B^2 sigma
            s = k - vac_perm*eq_2%sigma*g33/j
            
            ! divide by J |nabla psi|^2
            s = s/(j*h22)
            
            ! clean up
            nullify(j,g33,h22)
        end subroutine calc_derived_s_from_sigma_hel
        
        subroutine calc_derived_dc_epar(de,D_de,T_FE,D1_epar,D3_epar)
            use num_utilities, only: c
            
            ! input / output
            real(dp), intent(in) :: de(:,:,:,:,:,:)
            real(dp), intent(in) :: d_de(:,:,:,:,:)
            real(dp), intent(in) :: t_fe(:,:,:,:)
            real(dp), intent(out) :: d1_epar(:,:,:,:)
            real(dp), intent(out) :: d3_epar(:,:,:,:)
            
            ! initialize output
            d1_epar = 0._dp
            d3_epar = 0._dp
            
            ! transform
            do ld = 1,3
                do id = 1,2
                    do jd = 1,2
                        ! d/dalpha
                        d1_epar(:,:,:,ld) = d1_epar(:,:,:,ld) + &
                            &de(:,:,:,id,jd,ld) * &
                            &t_fe(:,:,:,c([1,1+id],.false.)) * &                ! 1 for alpha
                            &t_fe(:,:,:,c([3,1+jd],.false.)) 
                        ! d/dtheta
                        d3_epar(:,:,:,ld) = d3_epar(:,:,:,ld) + &
                            &de(:,:,:,id,jd,ld) * &
                            &t_fe(:,:,:,c([3,1+id],.false.)) * &                ! 3 for theta
                            &t_fe(:,:,:,c([3,1+jd],.false.)) 
                    end do
                    ! d/dalpha
                    d1_epar(:,:,:,ld) = d1_epar(:,:,:,ld) + &
                        &d_de(:,:,:,id,ld) * &
                        &t_fe(:,:,:,c([1,1+id],.false.))                        ! 1 for alpha
                    ! d/dtheta
                    d3_epar(:,:,:,ld) = d3_epar(:,:,:,ld) + &
                        &d_de(:,:,:,id,ld) * &
                        &t_fe(:,:,:,c([3,1+id],.false.))                        ! 3 for theta
                end do
            end do
        end subroutine calc_derived_dc_epar
        
        subroutine calc_derived_de_epar_vmec(grid_eq,eq_2,de,D_de,b_n,b_g)
            use num_utilities, only: c
            use num_vars, only: tol_zero
            
            ! input / output
            type(grid_type), intent(in) :: grid_eq
            type(eq_2_type), intent(in) :: eq_2
            real(dp), intent(out) :: de(:,:,:,:,:,:)
            real(dp), intent(out) :: d_de(:,:,:,:,:)
            real(dp), intent(out) :: b_n(:,:,:,:)
            real(dp), intent(out) :: b_g(:,:,:,:)
            
            ! initialize output
            de = 0._dp
            d_de = 0._dp
            b_n = 0._dp
            b_g = 0._dp
            
            ! calculate the derivatives of covariant unit vectors in Equilibrium
            ! coordinates
            
            ! d/dtheta e_theta
            de(:,:,:,1,1,1) = eq_2%R_E(:,:,:,0,2,0)                             ! ~ e_R
            !de(:,:,:,1,1,2) = 0._dp                                             ! ~ e_phi
            de(:,:,:,1,1,3) = eq_2%Z_E(:,:,:,0,2,0)                             ! ~ e_Z
            
            ! d/dzeta e_theta
            de(:,:,:,2,1,1) = eq_2%R_E(:,:,:,0,1,1)                             ! ~ e_R
            de(:,:,:,2,1,2) = eq_2%R_E(:,:,:,0,1,0)/eq_2%R_E(:,:,:,0,0,0)       ! ~ e_phi
            de(:,:,:,2,1,3) = eq_2%Z_E(:,:,:,0,1,1)                             ! ~ e_Z
            
            ! d/dtheta e_zeta
            de(:,:,:,1,2,1) = eq_2%R_E(:,:,:,0,1,1)                             ! ~ e_R
            de(:,:,:,1,2,2) = eq_2%R_E(:,:,:,0,1,0)/eq_2%R_E(:,:,:,0,0,0)       ! ~ e_phi
            de(:,:,:,1,2,3) = eq_2%Z_E(:,:,:,0,1,1)                             ! ~ e_Z
            
            ! d/dzeta e_zeta
            de(:,:,:,2,2,1) = eq_2%R_E(:,:,:,0,0,2)-eq_2%R_E(:,:,:,0,0,0)       ! ~ e_R
            de(:,:,:,2,2,2) = 2*eq_2%R_E(:,:,:,0,0,1)/eq_2%R_E(:,:,:,0,0,0)     ! ~ e_phi
            de(:,:,:,2,2,3) = eq_2%Z_E(:,:,:,0,0,2)                             ! ~ e_Z
            
            ! calculate  derivatives  of  transformation matrix  in  Equilibrium
            ! coordinates
            
            ! ~d/dtheta
            d_de(:,:,:,1,1) = eq_2%R_E(:,:,:,0,1,0)*&
                &eq_2%T_FE(:,:,:,c([3,2],.false.),0,1,0) + &
                &eq_2%R_E(:,:,:,0,0,1)*&
                &eq_2%T_FE(:,:,:,c([3,3],.false.),0,1,0)                        ! ~ e_R
            d_de(:,:,:,1,2) = eq_2%T_FE(:,:,:,c([3,3],.false.),0,1,0)           ! ~ e_phi
            d_de(:,:,:,1,3) = eq_2%Z_E(:,:,:,0,1,0)*&
                &eq_2%T_FE(:,:,:,c([3,2],.false.),0,1,0) + &
                &eq_2%Z_E(:,:,:,0,0,1)*&
                &eq_2%T_FE(:,:,:,c([3,3],.false.),0,1,0)                        ! ~ e_Z
            
            ! ~d/dzeta
            d_de(:,:,:,2,1) = eq_2%R_E(:,:,:,0,1,0)*&
                &eq_2%T_FE(:,:,:,c([3,2],.false.),0,0,1) + &
                &eq_2%R_E(:,:,:,0,0,1)*&
                &eq_2%T_FE(:,:,:,c([3,3],.false.),0,0,1)                        ! ~ e_R
            d_de(:,:,:,2,2) = eq_2%T_FE(:,:,:,c([3,3],.false.),0,0,1)           ! ~ e_phi
            d_de(:,:,:,2,3) = eq_2%Z_E(:,:,:,0,1,0)*&
                &eq_2%T_FE(:,:,:,c([3,2],.false.),0,0,1) + &
                &eq_2%Z_E(:,:,:,0,0,1)*&
                &eq_2%T_FE(:,:,:,c([3,3],.false.),0,0,1)                        ! ~ e_Z
            
            ! Decompose  normal and  geodesic basis  vectors into  contravariant
            ! cylindrical basis vectors.
            
            ! b_n
            b_n(:,:,:,2) = (eq_2%R_E(:,:,:,0,0,1)*eq_2%Z_E(:,:,:,0,1,0) - &
                &eq_2%R_E(:,:,:,0,1,0)*eq_2%Z_E(:,:,:,0,0,1))                   ! store RzetaZtheta - RthetaZeta
            b_n(:,:,:,1) = &
                &-eq_2%jac_FD(:,:,:,0,0,0) * (1+eq_2%L_E(:,:,:,0,1,0)) / &
                &max(tol_zero, ( (b_n(:,:,:,2)/eq_2%R_E(:,:,:,0,0,0))**2 + &
                &eq_2%R_E(:,:,:,0,1,0)**2 + eq_2%Z_E(:,:,:,0,1,0)**2 )) / &
                &eq_2%R_E(:,:,:,0,0,0)                                          ! set up common factor of all b_n
            b_n(:,:,:,2) = b_n(:,:,:,1) * b_n(:,:,:,2)                          ! finalize b_n(2)
            b_n(:,:,:,3) = b_n(:,:,:,1) * eq_2%R_E(:,:,:,0,1,0)                 ! finalize b_n(3)
            b_n(:,:,:,1) = -b_n(:,:,:,1) * eq_2%Z_E(:,:,:,0,1,0)                ! finalize b_n(1)
            
            ! b_g
            do kd = 1,grid_eq%loc_n_r
                b_g(:,:,kd,2) = eq_2%g_FD(:,:,kd,c([3,3],.true.),0,0,0) - &
                    &eq_2%g_FD(:,:,kd,c([1,3],.true.),0,0,0) * &
                    &eq_1%q_saf_FD(kd,0)                                        ! store J(B_theta + B_alpha q)
                b_g(:,:,kd,1) = (b_g(:,:,kd,2)*eq_2%L_E(:,:,kd,0,0,1)-&
                    &eq_2%g_FD(:,:,kd,c([1,3],.true.),0,0,0)) / &
                    &(1+eq_2%L_E(:,:,kd,0,1,0))                                 ! store J((B_theta + B_alpha q) L_zeta - B_alpha)/(1+L_theta)
            end do
            b_g(:,:,:,3) = b_g(:,:,:,1)*eq_2%Z_E(:,:,:,0,1,0) - &
                &b_g(:,:,:,2)*eq_2%Z_E(:,:,:,0,0,1)                             ! finalize b_g(3) (apart from pre-factor)
            b_g(:,:,:,1) = b_g(:,:,:,1)*eq_2%R_E(:,:,:,0,1,0) - &
                &b_g(:,:,:,2)*eq_2%R_E(:,:,:,0,0,1)                             ! finalize b_g(1) (apart from pre-factor)
            b_g(:,:,:,2) = -b_g(:,:,:,2)*eq_2%R_E(:,:,:,0,0,0)**2               ! finalize b_g(2) (apart from pre-factor)
            do ld = 1,3
                b_g(:,:,:,ld) = b_g(:,:,:,ld) / &
                    &eq_2%g_FD(:,:,:,c([3,3],.true.),0,0,0)                     ! prefactor 1/g_thetatheta
            end do
        end subroutine calc_derived_de_epar_vmec
        subroutine calc_derived_de_epar_hel(grid_eq,eq_1,Rchi,Zchi,&
            &de,D_de,b_n,b_g)
            
            use helena_vars, only: rbphi_h
            
            ! input / output
            type(grid_type), intent(in) :: grid_eq
            type(eq_1_type), intent(in) :: eq_1
            real(dp), intent(in) :: Rchi(:,:,0:)
            real(dp), intent(in) :: Zchi(:,:,0:)
            real(dp), intent(out) :: de(:,:,:,:,:,:)
            real(dp), intent(out) :: D_de(:,:,:,:,:)
            real(dp), intent(out) :: b_n(:,:,:,:)
            real(dp), intent(out) :: b_g(:,:,:,:)
            
            ! local variables
            integer :: kd_H                                                     ! kd in Helena tables
            real(dp), allocatable :: dum1(:,:)                                  ! dummy variable
            real(dp), allocatable :: dum2(:,:)                                  ! dummy variable
            
            ! initialize output
            de = 0._dp
            d_de = 0._dp
            b_n = 0._dp
            b_g = 0._dp
            
            ! calculate the derivatives of covariant unit vectors in Equilibrium
            ! coordinates
            
            ! d/dtheta e_theta
            de(:,1,:,1,1,1) = rchi(:,:,2)                                       ! ~ e_R
            !de(:,1,:,1,1,2) = 0._dp                                             ! ~ e_phi
            de(:,1,:,1,1,3) = zchi(:,:,2)                                       ! ~ e_Z
            
            ! d/dzeta e_theta
            !de(:,1,:,2,1,1) = 0._dp                                             ! ~ e_R
            de(:,1,:,2,1,2) = -rchi(:,:,1)/rchi(:,:,0)                          ! ~ e_phi
            !de(:,1,:,2,1,3) = 0._dp                                             ! ~ e_Z
            
            ! d/dtheta e_zeta
            !de(:,1,:,1,2,1) = 0._dp                                             ! ~ e_R
            de(:,1,:,1,2,2) = -rchi(:,:,1)/rchi(:,:,0)                          ! ~ e_phi
            !de(:,1,:,1,2,3) = 0._dp                                             ! ~ e_Z
            
            ! d/dzeta e_zeta
            de(:,1,:,2,2,1) = -rchi(:,:,0)                 ! ~ e_R
            !de(:,1,:,2,2,2) = 0._dp                                             ! ~ e_phi
            !de(:,1,:,2,2,3) = 0._dp                                             ! ~ e_Z
            
            ! Decompose  normal and  geodesic basis  vectors into  contravariant
            ! cylindrical basis vectors.
            do jd = 1,grid_eq%n(2)
                ! auxiliary variables
                allocate(dum1(grid_eq%n(1),grid_eq%loc_n_r))                    ! Rchi^2 + Zchi^2
                allocate(dum2(grid_eq%n(1),grid_eq%loc_n_r))                    ! Rchi^2 + Zchi^2 + (qR)^2
                dum1 = rchi(:,:,1)**2 + zchi(:,:,1)**2
                do kd = 1,grid_eq%loc_n_r
                    dum2(:,kd) = dum1(:,kd) + &
                        &(eq_1%q_saf_FD(kd,0)*rchi(:,kd,0))**2
                end do
                
                ! b_n
                b_n(:,jd,:,1) = rchi(:,:,0)*zchi(:,:,1)/dum1
                b_n(:,jd,:,3) = -rchi(:,:,0)*rchi(:,:,1)/dum1
                
                ! b_g
                b_g(:,jd,:,1) = -rchi(:,:,0)**2 * rchi(:,:,1)/dum2
                b_g(:,jd,:,2) = -rchi(:,:,0)**2 * dum1/dum2
                b_g(:,jd,:,3) = -rchi(:,:,0)**2 * zchi(:,:,1)/dum2
                
                ! clean up
                deallocate(dum1,dum2)
            end do
            do kd = 1,grid_eq%loc_n_r
                kd_h = grid_eq%i_min-1+kd
                b_n(:,:,kd,:) = b_n(:,:,kd,:) * &
                    &eq_1%q_saf_FD(kd,0)/rbphi_h(kd_h,0)
                b_g(:,:,kd,1:3:2) = b_g(:,:,kd,1:3:2) * eq_1%q_saf_FD(kd,0)     ! not b_g(2)
            end do
        end subroutine calc_derived_de_epar_hel
        
        subroutine calc_derived_kappa_from_e(grid_eq,eq_1,eq_2,b_n,b_g,&
            &kappa_n,kappa_g)
            
            use num_utilities, only: c
            
            ! input / output
            type(grid_type), intent(in) :: grid_eq
            type(eq_1_type), intent(in) :: eq_1
            type(eq_2_type), intent(in) :: eq_2
            real(dp), intent(in) :: b_n(:,:,:,:)
            real(dp), intent(in) :: b_g(:,:,:,:)
            real(dp), intent(out) :: kappa_n(:,:,:)
            real(dp), intent(out) :: kappa_g(:,:,:)
            
            ! calculate curvature: dot d/dtheta e_theta and basis vectors
            kappa_n = 0._dp
            kappa_g = 0._dp
            do ld = 1,3
                kappa_n = kappa_n + d3_epar(:,:,:,ld) * b_n(:,:,:,ld)
                kappa_g = kappa_g + d3_epar(:,:,:,ld) * b_g(:,:,:,ld)
            end do
            
            ! divide by |e_theta|^2
            kappa_n = kappa_n / eq_2%g_FD(:,:,:,c([3,3],.true.),0,0,0)
            kappa_g = kappa_g / eq_2%g_FD(:,:,:,c([3,3],.true.),0,0,0)
            
            ! possibly correct for toroidal flux
            if (.not.use_pol_flux_f) then
                do kd = 1,grid_eq%loc_n_r
                    kappa_n(:,:,kd) = kappa_n(:,:,kd) * eq_1%q_saf_E(kd,0)
                    kappa_g(:,:,kd) = kappa_g(:,:,kd) / eq_1%q_saf_E(kd,0)
                end do
            end if
        end subroutine calc_derived_kappa_from_e
        
        subroutine calc_derived_sigma_from_e(eq_2,b_n,sigma)
            use num_utilities, only: c
            
            ! input / output
            type(eq_2_type), intent(in) :: eq_2
            real(dp), intent(in) :: b_n(:,:,:,:)
            real(dp), intent(out) :: sigma(:,:,:)
            
            ! calculate the parallel current
            sigma = 0._dp
            do ld = 1,3
                sigma = sigma + 2._dp * b_n(:,:,:,ld) * &
                    &(d3_epar(:,:,:,ld) * &
                    &eq_2%g_FD(:,:,:,c([1,3],.true.),0,0,0) - &
                    &d1_epar(:,:,:,ld) * &
                    &eq_2%g_FD(:,:,:,c([3,3],.true.),0,0,0)) / &
                    &eq_2%jac_FD(:,:,:,0,0,0)**2
            end do
            
            ! add shear term and divide by -B_theta mu_0
            sigma = -(sigma + eq_2%jac_FD(:,:,:,0,0,0) * &
                &eq_2%h_FD(:,:,:,c([2,2],.true.),0,0,0)*eq_2%S) * &
                &eq_2%jac_FD(:,:,:,0,0,0)/&
                &(vac_perm*eq_2%g_FD(:,:,:,c([3,3],.true.),0,0,0))
        end subroutine calc_derived_sigma_from_e
        
        subroutine calc_derived_sigma_hel(grid_eq,eq_2,sigma)
            use helena_vars, only: rbphi_h
            use num_utilities, only: c
            
            ! input / output
            type(grid_type), intent(in) :: grid_eq
            type(eq_2_type), intent(in), target :: eq_2
            real(dp), intent(out) :: sigma(:,:,:)
            
            ! local variables
            integer :: kd                                                       ! counter
            integer :: kd_H                                                     ! kd in Helena tables
            real(dp), pointer :: J(:,:,:) => null()                             ! jac
            real(dp), pointer :: g13(:,:,:) => null()                           ! g_alpha,theta
            real(dp), pointer :: g33(:,:,:) => null()                           ! g_theta,theta
            
            ! set up submatrices
            j => eq_2%jac_FD(:,:,:,0,0,0)
            g13 => eq_2%g_FD(:,:,:,c([1,3],.true.),0,0,0)
            g33 => eq_2%g_FD(:,:,:,c([3,3],.true.),0,0,0)
            
            ! calculate parallel current using direct formula
            do kd = 1,grid_eq%loc_n_r
                kd_h = grid_eq%i_min-1+kd
                sigma(:,:,kd) = -rbphi_h(kd_h,1) / vac_perm - &
                    &eq_1%pres_FD(kd,1)*j(:,:,kd)*g13(:,:,kd)/g33(:,:,kd)
            end do 
            
            ! clean up
            nullify(j,g13,g33)
        end subroutine calc_derived_sigma_hel
        
#if ldebug
 
        integer function plot_derived_q(grid_eq,eq_2) result(ierr)
            use num_vars, only: prog_style, eq_jobs_lims, eq_job_nr, &
                &use_normalization, mu_0_original
            use grid_utilities, only: trim_grid, calc_xyz_grid
            use grid_vars, only: alpha
            use eq_vars, only: max_flux_f, b_0, r_0
            
            character(*), parameter :: rout_name = 'plot_derived_q'
            
            ! input / output
            type(grid_type), intent(in) :: grid_eq
            type(eq_2_type), intent(in) :: eq_2
            
            ! local variables
            type(grid_type) :: grid_trim                                        ! trimmed equilibrium grid
            real(dp) :: norm_factors(4)                                         ! normalization factors
            real(dp), allocatable :: X_plot(:,:,:)                              ! x values of total plot
            real(dp), allocatable :: Y_plot(:,:,:)                              ! y values of total plot
            real(dp), allocatable :: Z_plot(:,:,:)                              ! z values of total plot
            real(dp), pointer :: ang_par_F(:,:,:) => null()                     ! parallel angle theta_F or zeta_F
            integer :: norm_id(2)                                               ! untrimmed normal indices for trimmed grids
            integer :: plot_dim(3)                                              ! dimensions of plot
            integer :: plot_offset(3)                                           ! local offset of plot
            logical :: cont_plot                                                ! continued plot
            
            ! initialize ierr
            ierr = 0
            
            call writo('Plotting derived equilibrium quantities')
            call lvl_ud(1)
            
            ! trim equilibrium grid
            ierr = trim_grid(grid_eq,grid_trim,norm_id)
            chckerr('')
            
            ! allocate variables
            allocate(x_plot(grid_trim%n(1),grid_trim%n(2),grid_trim%loc_n_r))
            allocate(y_plot(grid_trim%n(1),grid_trim%n(2),grid_trim%loc_n_r))
            allocate(z_plot(grid_trim%n(1),grid_trim%n(2),grid_trim%loc_n_r))
            
            ! point parallel angle
            if (use_pol_flux_f) then
                ang_par_f => grid_eq%theta_F
            else
                ang_par_f => grid_eq%zeta_F
            end if
            
            ! calculate grid
            select case (prog_style)
                case (1)                                                        ! PB3D
                    select case (eq_style)
                        case (1)                                                ! VMEC
                            x_plot = ang_par_f(:,:,norm_id(1):norm_id(2))
                            do jd = 1,grid_trim%n(2)
                                y_plot(:,jd,:) = alpha(jd)
                            end do
                            do kd = 1,grid_trim%loc_n_r
                                z_plot(:,:,kd) = &
                                    &grid_trim%r_F(kd)*2*pi/max_flux_f
                            end do
                        case (2)                                                ! HELENA
                            ierr = calc_xyz_grid(grid_eq,grid_trim,x_plot,&
                                &y_plot,z_plot)
                            chckerr('')
                    end select
                case (2)                                                        ! POST
                    ierr = calc_xyz_grid(grid_eq,grid_trim,x_plot,y_plot,z_plot)
                    chckerr('')
            end select
            
            ! set up plot dimensions and offset
            select case (eq_style)
                case (1)                                                        ! VMEC
                    plot_dim = [eq_jobs_lims(2,size(eq_jobs_lims,2)) - &
                        &eq_jobs_lims(1,1) + 1, grid_trim%n(2:3)]
                    plot_offset = [eq_jobs_lims(1,eq_job_nr)-1,0,&
                        &grid_trim%i_min-1]
                    cont_plot = eq_job_nr.gt.1
                case (2)                                                        ! HELENA
                    plot_dim = grid_trim%n
                    plot_offset = [0,0,grid_trim%i_min-1]
                    cont_plot = .false.
            end select
            
            ! set up normalization factors
            norm_factors = 1._dp
            if (use_normalization) then
                norm_factors(1) = 1._dp/(mu_0_original*r_0)                     ! sigma
                norm_factors(2) = 1._dp/(r_0**3)                                ! S
                norm_factors(3) = 1._dp/(r_0*b_0)                               ! kappa_n
                norm_factors(4) = 1._dp                                         ! kappa_g
            end if
            
            ! plot sigma
            call plot_hdf5('sigma','TEST_sigma',&
                &eq_2%sigma(:,:,norm_id(1):norm_id(2))*norm_factors(1),&
                &tot_dim=plot_dim,loc_offset=plot_offset,cont_plot=cont_plot,&
                &x=x_plot,y=y_plot,z=z_plot)
            
            ! plot shear
            call plot_hdf5('shear','TEST_S',&
                &eq_2%S(:,:,norm_id(1):norm_id(2))*norm_factors(2),&
                &tot_dim=plot_dim,loc_offset=plot_offset,cont_plot=cont_plot,&
                &x=x_plot,y=y_plot,z=z_plot)
            
            ! plot kappa_n
            call plot_hdf5('kappa_n','TEST_kappa_n',&
                &eq_2%kappa_n(:,:,norm_id(1):norm_id(2))*norm_factors(3),&
                &tot_dim=plot_dim,loc_offset=plot_offset,cont_plot=cont_plot,&
                &x=x_plot,y=y_plot,z=z_plot)
            
            ! plot kappa_g
            call plot_hdf5('kappa_g','TEST_kappa_g',&
                &eq_2%kappa_g(:,:,norm_id(1):norm_id(2))*norm_factors(4),&
                &tot_dim=plot_dim,loc_offset=plot_offset,cont_plot=cont_plot,&
                &x=x_plot,y=y_plot,z=z_plot)
            
            ! clean up
            nullify(ang_par_f)
            call grid_trim%dealloc()
            
            call lvl_ud(-1)
        end function plot_derived_q
        
        integer function test_sigma_with_kappa_g(grid_eq,eq_1,eq_2) result(ierr)
            use num_utilities, only: spline, calc_int
            use num_vars, only: norm_disc_prec_eq
            
            character(*), parameter :: rout_name = 'test_sigma_with_kappa_g'
            
            ! input / output
            type(grid_type), intent(in) :: grid_eq
            type(eq_1_type), intent(in) :: eq_1
            type(eq_2_type), intent(in) :: eq_2
            
            ! local variables
            real(dp), allocatable :: sigma_ALT(:,:,:)                           ! alternative sigma
            real(dp), allocatable :: D3sigma(:,:,:)                             ! D_theta sigma
            real(dp), allocatable :: D3sigma_ALT(:,:,:)                         ! alternative D_theta sigma
            real(dp), pointer :: ang_par_F(:,:,:) => null()                     ! parallel angle theta_F or zeta_F
            
            ! initialize ierr
            ierr = 0
            
            call writo('Testing whether -2 p'' J kappa_g = D3sigma')
            call lvl_ud(1)
            
            ! point parallel angle
            if (use_pol_flux_f) then
                ang_par_f => grid_eq%theta_F
            else
                ang_par_f => grid_eq%zeta_F
            end if
            
            ! allocate variables
            allocate(d3sigma(grid_eq%n(1),grid_eq%n(2),grid_eq%loc_n_r))
            allocate(d3sigma_alt(grid_eq%n(1),grid_eq%n(2),grid_eq%loc_n_r))
            allocate(sigma_alt(grid_eq%n(1),grid_eq%n(2),grid_eq%loc_n_r))
            
            ! get derivative of sigma
            do kd = 1,grid_eq%loc_n_r
                do jd = 1,grid_eq%n(2)
                    ierr = spline(ang_par_f(:,jd,kd),eq_2%sigma(:,jd,kd),&
                        &ang_par_f(:,jd,kd),d3sigma(:,jd,kd),&
                        &ord=norm_disc_prec_eq,deriv=1)
                    chckerr('')
                end do
            end do
            
            ! calculate alternatively derived sigma
            do kd = 1,grid_eq%loc_n_r
                d3sigma_alt(:,:,kd) = -2*eq_1%pres_FD(kd,1)*&
                    &eq_2%kappa_g(:,:,kd)*eq_2%jac_FD(:,:,kd,0,0,0)
            end do
            
            ! calculate alternative sigma by integration
            ! Note:  there  is  an  undetermined constant  of  integration  that
            ! depends on the normal coordinate and the geodesic coordinate.
            do kd = 1,grid_eq%loc_n_r
                do jd = 1,grid_eq%n(2)
                    ierr = calc_int(d3sigma_alt(:,jd,kd),ang_par_f(:,jd,kd),&
                        &sigma_alt(:,jd,kd))
                    chckerr('')
                end do
                sigma_alt(:,:,kd) = eq_2%sigma(1,1,kd) + sigma_alt(:,:,kd)
            end do
            
            ! plot output
            call plot_diff_hdf5(d3sigma,d3sigma_alt,&
                &'TEST_diff_D3sigma_through_kappa_g',&
                &grid_eq%n,[0,0,grid_eq%i_min-1],&
                &descr='To test whether -2 p'' J kappa_g = D3sigma',&
                &output_message=.true.)
            call plot_diff_hdf5(eq_2%sigma,sigma_alt,&
                &'TEST_diff_sigma_through_kappa_g',&
                &grid_eq%n,[0,0,grid_eq%i_min-1],descr='To test whether &
                &int(-2 p'' J kappa_g) = sigma',output_message=.true.)
            
            ! clean up
            nullify(ang_par_f)
            
            call lvl_ud(-1)
        end function test_sigma_with_kappa_g
        
        integer function test_kappa(grid_eq,eq_1,eq_2) result(ierr)
            use num_utilities, only: c
            
            character(*), parameter :: rout_name = 'test_kappa'
            
            ! input / output
            type(grid_type), intent(in) :: grid_eq
            type(eq_1_type), intent(in) :: eq_1
            type(eq_2_type), intent(in), target :: eq_2
            
            ! local variables
            real(dp), allocatable :: kappa_ALT(:,:,:,:)                         ! alternative kappa_n (1) and kappa_g(2)
            real(dp), pointer :: J(:,:,:) => null()                             ! jac
            real(dp), pointer :: D1J(:,:,:) => null()                           ! D_alpha jac
            real(dp), pointer :: D2J(:,:,:) => null()                           ! D_psi jac
            real(dp), pointer :: D3J(:,:,:) => null()                           ! D_theta jac
            real(dp), pointer :: g13(:,:,:) => null()                           ! g_alpha,theta
            real(dp), pointer :: g33(:,:,:) => null()                           ! g_theta,theta
            real(dp), pointer :: D1g33(:,:,:) => null()                         ! D_alpha g_theta,theta
            real(dp), pointer :: D2g33(:,:,:) => null()                         ! D_psi g_theta,theta
            real(dp), pointer :: D3g33(:,:,:) => null()                         ! D_theta g_theta,theta
            real(dp), pointer :: h12(:,:,:) => null()                           ! h_alpha,psi
            real(dp), pointer :: h22(:,:,:) => null()                           ! h_psi,psi
            real(dp), pointer :: h23(:,:,:) => null()                           ! h_psi,theta
            
            ! initialize ierr
            ierr = 0
            
            call writo('Testing whether kappa agrees with naive implementation')
            call lvl_ud(1)
            
            ! set up submatrices
            j => eq_2%jac_FD(:,:,:,0,0,0)
            d1j => eq_2%jac_FD(:,:,:,1,0,0)
            d2j => eq_2%jac_FD(:,:,:,0,1,0)
            d3j => eq_2%jac_FD(:,:,:,0,0,1)
            g13 => eq_2%g_FD(:,:,:,c([1,3],.true.),0,0,0)
            g33 => eq_2%g_FD(:,:,:,c([3,3],.true.),0,0,0)
            d1g33 => eq_2%g_FD(:,:,:,c([3,3],.true.),1,0,0)
            d2g33 => eq_2%g_FD(:,:,:,c([3,3],.true.),0,1,0)
            d3g33 => eq_2%g_FD(:,:,:,c([3,3],.true.),0,0,1)
            h12 => eq_2%h_FD(:,:,:,c([1,2],.true.),0,0,0)
            h22 => eq_2%h_FD(:,:,:,c([2,2],.true.),0,0,0)
            h23 => eq_2%h_FD(:,:,:,c([2,3],.true.),0,0,0)
            
            ! initialize
            allocate(kappa_alt(grid_eq%n(1),grid_eq%n(2),grid_eq%loc_n_r,2))
            kappa_alt = 0._dp
            
            ! Calculate naive normal curvature kappa_n
            do kd = 1,grid_eq%loc_n_r
                kappa_alt(:,:,kd,1) = &
                    &vac_perm*j(:,:,kd)**2*eq_1%pres_FD(kd,1)/g33(:,:,kd) + &
                    &1._dp/(2*h22(:,:,kd)) * ( &
                    &h12(:,:,kd) * ( d1g33(:,:,kd)/g33(:,:,kd) - &
                    &2*d1j(:,:,kd)/j(:,:,kd) ) + &
                    &h22(:,:,kd) * ( d2g33(:,:,kd)/g33(:,:,kd) - &
                    &2*d2j(:,:,kd)/j(:,:,kd) ) + &
                    &h23(:,:,kd) * ( d3g33(:,:,kd)/g33(:,:,kd) - &
                    &2*d3j(:,:,kd)/j(:,:,kd) ) )
            end do
            
            ! Calculate naive geodesic curvature kappa_g
            kappa_alt(:,:,:,2) = (0.5*d1g33/g33 - d1j/j) - &
                &g13/g33*(0.5*d3g33/g33 - d3j/j)
            
            call plot_diff_hdf5(eq_2%kappa_n,kappa_alt(:,:,:,1),&
                &'TEST_diff_kappa_n',grid_eq%n,[0,0,grid_eq%i_min-1],&
                &descr='To test whether kappa_n agrees with naive calculation',&
                &output_message=.true.)
            call plot_diff_hdf5(eq_2%kappa_g,kappa_alt(:,:,:,2),&
                &'TEST_diff_kappa_g',grid_eq%n,[0,0,grid_eq%i_min-1],&
                &descr='To test whether kappa_g agrees with naive calculation',&
                &output_message=.true.)
            
            !!! temporary: for 2018 paper
            !!ierr = plot_diff_for_paper(grid_eq%loc_r_F,eq_2%kappa_n,&
                !!&kappa_ALT(:,:,:,1),'kappa_n')
            !!CHCKERR('')
            !!ierr = plot_diff_for_paper(grid_eq%loc_r_F,eq_2%kappa_g,&
                !!&kappa_ALT(:,:,:,2),'kappa_g')
            !!CHCKERR('')
            
            ! clean up
            nullify(j,d1j,d2j,d3j,g13,g33,d1g33,d2g33,d3g33,h12,h22,h23)
            
            call lvl_ud(-1)
        end function test_kappa
        
        integer function test_sigma_vmec(grid_eq,eq_1,eq_2) result(ierr)
            use num_utilities, only: spline, calc_int, c
            use num_vars, only: norm_disc_prec_eq
            use vmec_vars, only: b_v_sub_s, b_v_sub_c, is_asym_v
            use vmec_utilities, only: fourier2real
            
            character(*), parameter :: rout_name = 'test_sigma_VMEC'
            
            ! input / output
            type(grid_type), intent(in) :: grid_eq
            type(eq_1_type), intent(in) :: eq_1
            type(eq_2_type), intent(in), target :: eq_2
            
            ! local variables
            real(dp), allocatable :: sigma_ALT(:,:,:)                           ! alternative sigma
            real(dp), allocatable :: B_V(:,:,:,:)                               ! magnetic field in VMEC coordinates
            real(dp), allocatable :: B_alpha(:,:,:)                             ! B_alpha Flux coordinates
            real(dp), pointer :: J(:,:,:) => null()                             ! jac
            real(dp), pointer :: D1J(:,:,:) => null()                           ! D_alpha jac
            real(dp), pointer :: g13(:,:,:) => null()                           ! g_alpha,theta
            real(dp), pointer :: g23(:,:,:) => null()                           ! g_psi,theta
            real(dp), pointer :: D1g23(:,:,:) => null()                         ! D_alpha g_psi,theta
            real(dp), pointer :: g33(:,:,:) => null()                           ! g_theta,theta
            
            ! initialize ierr
            ierr = 0
            
            call writo('Testing whether sigma agrees with naive implementation')
            call lvl_ud(1)
            
            ! set up submatrices
            j => eq_2%jac_FD(:,:,:,0,0,0)
            d1j => eq_2%jac_FD(:,:,:,1,0,0)
            g13 => eq_2%g_FD(:,:,:,c([1,3],.true.),0,0,0)
            g23 => eq_2%g_FD(:,:,:,c([2,3],.true.),0,0,0)
            d1g23 => eq_2%g_FD(:,:,:,c([2,3],.true.),1,0,0)
            g33 => eq_2%g_FD(:,:,:,c([3,3],.true.),0,0,0)
            
            ! initialize
            allocate(sigma_alt(grid_eq%n(1),grid_eq%n(2),grid_eq%loc_n_r))
            sigma_alt = 0._dp
            
            ! magnetic field in VMEC coordinates
            allocate(b_v(grid_eq%n(1),grid_eq%n(2),grid_eq%loc_n_r,2:3))
            do id = 2,3                                                         ! only angular V components count for e_alpha
                ierr = fourier2real(&
                    &b_v_sub_c(:,grid_eq%i_min:grid_eq%i_max,id),&
                    &b_v_sub_s(:,grid_eq%i_min:grid_eq%i_max,id),&
                    &grid_eq%trigon_factors,b_v(:,:,:,id),&
                    &[.true.,is_asym_v])
                chckerr('')
            end do
            
            ! transform them to Flux coord. system
            allocate(b_alpha(grid_eq%n(1),grid_eq%n(2),grid_eq%loc_n_r))
            b_alpha = 0._dp
            do kd = 2,3
                b_alpha = b_alpha + b_v(:,:,:,kd) * &
                    &eq_2%T_FE(:,:,:,c([1,kd],.false.),0,0,0)
            end do
            
            !!! more elegant but less accurate alternative:
            !!B_alpha = g13/J
            
            ! derivate in normal direction
            do jd = 1,grid_eq%n(2)
                do id = 1,grid_eq%n(1)
                    ierr = spline(grid_eq%loc_r_F,b_alpha(id,jd,:),&
                        &grid_eq%loc_r_F,sigma_alt(id,jd,:),&
                        &ord=norm_disc_prec_eq,deriv=1)
                    chckerr('')
                end do
            end do
            
            ! contribute to sigma
            sigma_alt = (d1g23 - g23*d1j/j)/j - sigma_alt
            
            !!! equally elegant but also inaccurate second alternative:
            !!sigma_ALT = (D1g23 - g23*D1J/J)/J - (D2g13 - g13*D2J/J)/J
            do kd = 1,grid_eq%loc_n_r
                sigma_alt(:,:,kd) = sigma_alt(:,:,kd) / vac_perm - &
                    &eq_1%pres_FD(kd,1)*j(:,:,kd)*g13(:,:,kd)/g33(:,:,kd)
            end do 
            
            call plot_diff_hdf5(eq_2%sigma,sigma_alt,'TEST_diff_sigma',&
                &grid_eq%n,[0,0,grid_eq%i_min-1],descr='To test whether &
                &sigma agrees with naive calculation',output_message=.true.)
            
            !!! temporary: for 2018 paper
            !!ierr = plot_diff_for_paper(grid_eq%loc_r_F,eq_2%sigma,sigma_ALT,&
                !!&'sigma')
            !!CHCKERR('')
            
            ! clean up
            nullify(j,d1j,g13,g23,d1g23,g33)
            
            call lvl_ud(-1)
        end function test_sigma_vmec
        
        subroutine test_s_hel(grid_eq,eq_2,Rchi,Zchi)
            ! input / output
            type(grid_type), intent(in) :: grid_eq
            type(eq_2_type), intent(in) :: eq_2
            real(dp), intent(in) :: Rchi(:,:,0:)
            real(dp), intent(in) :: Zchi(:,:,0:)
            
            ! local variables
            real(dp), allocatable :: S_ALT(:,:,:)                               ! alternative shear
            
            call writo('Testing whether shear agrees with alternative &
                &implementation using sigma')
            call lvl_ud(1)
            
            allocate(s_alt(grid_eq%n(1),grid_eq%n(2),grid_eq%loc_n_r))
            
            ! calculate implementation with identity using sigma
            call calc_derived_s_from_sigma_hel(grid_eq,eq_2,rchi,zchi,s_alt)
            call plot_diff_hdf5(eq_2%S,s_alt,'TEST_diff_S_from_sigma',&
                &grid_eq%n,[0,0,grid_eq%i_min-1],descr='To test whether &
                &sigma agrees with naive calculation',output_message=.true.)
            
            ! calculate naive implementation
            call calc_derived_s_direct(eq_2,s_alt)
            call plot_diff_hdf5(eq_2%S,s_alt,'TEST_diff_S_naive',&
                &grid_eq%n,[0,0,grid_eq%i_min-1],descr='To test whether &
                &sigma agrees with naive calculation',output_message=.true.)
            
            call lvl_ud(-1)
        end subroutine test_s_hel
        
        integer function plot_diff_for_paper(r, A, B, title) result(ierr)
            use num_vars, only: n_procs
            
            character(*), parameter :: rout_name = 'plot_diff_for_paper'
            
            ! input / output
            real(dp), intent(in) :: r(:)
            real(dp), intent(in) :: A(:,:,:)
            real(dp), intent(in) :: B(:,:,:)
            character(len=*), intent(in) :: title
            
            ! local variables
            integer :: jd, kd                                                   ! counters
            integer :: n_r                                                      ! size of r
            integer :: n_par                                                    ! number of parallel points
            character(len=max_str_ln) :: plot_title(3)                          ! titles of plot (GOOD, BAD, diff)
            
            ! initialize ierr
            ierr = 0
            
            if (n_procs.gt.1) then
                ierr = 1
                chckerr('Need 1 process')
            end if
            
            n_r = size(r)
            n_par = size(a, 1)
            
            do jd = 1,size(a,2)
                plot_title(1) = trim(title)//'_GOOD'
                plot_title(2) = trim(title)//'_BAD'
                plot_title(3) = trim(title)//'_DIFF'
                if (jd.gt.1) then
                    do kd = 1,3
                        plot_title(kd) = trim(plot_title(kd))//'_'//&
                            &trim(i2str(kd))
                    end do
                end if
                call print_ex_2d([''],plot_title(1),transpose(a(:,jd,:)),&
                    &x=reshape(r*2*pi/max_flux_f,[n_r,1]),draw=.false.)
                call draw_ex([''],plot_title(1),n_par,1,.false.)
                call print_ex_2d([''],plot_title(2),transpose(b(:,jd,:)),&
                    &x=reshape(r*2*pi/max_flux_f,[n_r,1]),draw=.false.)
                call draw_ex([''],plot_title(2),n_par,1,.false.)
                call print_ex_2d([''],plot_title(3),&
                    &transpose(abs(b(:,jd,:)-a(:,jd,:))/&
                    &(abs(b(:,jd,:))+abs(a(:,jd,:)))),&
                    &x=reshape(r*2*pi/max_flux_f,[n_r,1]),draw=.false.)
                call draw_ex([''],plot_title(3),n_par,1,.false.)
            end do
        end function plot_diff_for_paper
#endif
    end function calc_derived_q
    
    integer function calc_normalization_const() result(ierr)
        use num_vars, only: rank, eq_style, mu_0_original, use_normalization, &
            &rich_restart_lvl
        use eq_vars, only: t_0, b_0, pres_0, psi_0, r_0, rho_0
        
        character(*), parameter :: rout_name = 'calc_normalization_const'
        
        ! local variables
        integer :: nr_overridden_const                                          ! nr. of user-overridden constants, to print warning if > 0
        character(len=max_str_ln) :: err_msg                                    ! error message
        
        ! initialize ierr
        ierr = 0
        
        ! initialize BR_normalization_provided
        br_normalization_provided = [.false.,.false.]
        
        if (use_normalization) then
            ! user output
            call writo('Calculating the normalization constants')
            call lvl_ud(1)
            
            ! initialize nr_overridden_const
            nr_overridden_const = 0
            
            ! calculation
            if (rank.eq.0) then
                ! choose which equilibrium style is being used:
                !   1:  VMEC
                !   2:  HELENA
                select case (eq_style)
                    case (1)                                                    ! VMEC
                        call calc_normalization_const_vmec
                    case (2)                                                    ! HELENA
                        call calc_normalization_const_hel
                end select
            end if
            
            ! print warning if user-overridden
            if (nr_overridden_const.gt.0) &
                &call writo(trim(i2str(nr_overridden_const))//&
                &' constants were overridden by user. Consistency is NOT &
                &checked!',warning=.true.)
            
            ! print constants
            call print_normalization_const(r_0,rho_0,b_0,pres_0,psi_0,&
                &mu_0_original,t_0)
            
            ! check whether it is physically consistent
            if (t_0.lt.0._dp) then
                ierr = 1
                err_msg = 'Alfven time is negative. Are you sure the &
                    &equilibrium is consistent?'
                chckerr(err_msg)
            end if
            
            ! user output
            call lvl_ud(-1)
            call writo('Normalization constants calculated')
        else if (rich_restart_lvl.eq.1) then                                    ! only for first Richardson leevel
            ! user output
            call writo('Normalization not used')
        end if
    contains 
        ! VMEC version
        subroutine calc_normalization_const_vmec
            use num_vars, only: norm_style
            use vmec_vars, only: r_v_c, b_0_v, rmax_surf, rmin_surf, pres_v, &
                &beta_v
            !use VMEC_vars, only: aspr_V
            
            select case (norm_style)
                ! Note that PB3D does not run with the exact COBRA normalization
                ! (for style 2), as it is not a pure nondimensionalization, that
                ! would  modify the  equations by  intrucing extra  factors. The
                ! diffference between the COBRA  normalization used here and the
                ! one used in COBRA is given by:
                !   - B_0 = sqrt(pres_0 mu_0) here
                !       versus
                !     B_0 = sqrt(2 pres_0 mu_0 / beta) in COBRA,
                !   - psi_0 = B_0 R_0^2 here
                !       versus
                !     psi_0 = B_0 (R_0/aspr)^2 in COBRA,
                ! This results in a difference in the factor T_0:
                !   - T_0 = sqrt(rho_0/pres_0) R_0 here
                !       versus
                !     T_0 = sqrt(rho_0/pres_0) R_0 sqrt(beta/2) in COBRA.
                ! Therefore, the Eigenvalues here should be rescaled as
                !   - EV_COBRA = EV_PB3D beta/2. This is done automatically.
                case (1)                                                        ! MISHKA
                    ! user output
                    call writo('Using MISHKA normalization')
                    
                    ! set the  major radius as the  average value of R_V  on the
                    ! magnetic axis
                    if (r_0.ge.huge(1._dp)) then                                ! user did not provide a value
                        r_0 = r_v_c(1,1,0)
                    else
                        nr_overridden_const = nr_overridden_const + 1
                    end if
                    
                    ! set B_0 from magnetic field on axis
                    if (b_0.ge.huge(1._dp)) then                                ! user did not provide a value
                        b_0 = b_0_v
                    else
                        nr_overridden_const = nr_overridden_const + 1
                    end if
                    
                    ! set reference pres_0 from B_0
                    if (pres_0.ge.huge(1._dp)) then                             ! user did not provide a value
                        pres_0 = b_0**2/mu_0_original
                    else
                        nr_overridden_const = nr_overridden_const + 1
                    end if
                    
                    ! set reference flux from R_0 and B_0
                    if (psi_0.ge.huge(1._dp)) then                              ! user did not provide a value
                        psi_0 = r_0**2 * b_0
                    else
                        nr_overridden_const = nr_overridden_const + 1
                    end if
                case (2)                                                        ! COBRA
                    ! user output
                    call writo('Using COBRA normalization')
                    
                    ! set the major radius as the average geometric axis
                    if (r_0.ge.huge(1._dp)) then                                ! user did not provide a value
                        r_0 = 0.5_dp*(rmin_surf+rmax_surf)
                    else
                        nr_overridden_const = nr_overridden_const + 1
                    end if
                    
                    ! set pres_0 from pressure on axis
                    if (pres_0.ge.huge(1._dp)) then                             ! user did not provide a value
                        pres_0 = pres_v(1,0)
                    else
                        nr_overridden_const = nr_overridden_const + 1
                    end if
                    
                    ! set the reference value for B_0 from pres_0 and beta
                    if (b_0.ge.huge(1._dp)) then                                ! user did not provide a value
                        !B_0 = sqrt(2._dp*pres_0*mu_0_original/beta_V)          ! exact COBRA
                        b_0 = sqrt(pres_0*mu_0_original)                        ! pure modified COBRA
                    else
                        nr_overridden_const = nr_overridden_const + 1
                    end if
                    
                    ! set reference flux from R_0, B_0 and aspr
                    if (psi_0.ge.huge(1._dp)) then                              ! user did not provide a value
                        !psi_0 = B_0 * (R_0/aspr_V)**2                          ! exact COBRA
                        psi_0 = b_0 * r_0**2                                    ! pure modified COBRA
                    else
                        nr_overridden_const = nr_overridden_const + 1
                    end if
                    
                    ! user output concerning pure modified COBRA
                    call writo('Exact COBRA normalization is substituted by &
                        &"pure", modified version',warning=.true.)
                    call writo('This leaves the equations unmodified',&
                        &alert=.true.)
                    call writo('To translate to exact COBRA, manually multiply &
                        &PB3D Eigenvalues by',alert=.true.)
                    call lvl_ud(1)
                    call writo(trim(r2str(beta_v/2)),alert=.true.)
                    call lvl_ud(-1)
            end select
            
            ! rho_0 is set up through an input variable with the same name
            
            ! set Alfven time
            if (t_0.ge.huge(1._dp)) then                                        ! user did not provide a value
                t_0 = sqrt(mu_0_original*rho_0)*r_0/b_0
            else
                nr_overridden_const = nr_overridden_const + 1
            end if
        end subroutine calc_normalization_const_vmec
        
        ! HELENA version
        subroutine calc_normalization_const_hel
            ! user output
            call writo('Using MISHKA normalization')
            
            if (r_0.ge.huge(1._dp)) then                                        ! user did not provide a value
                r_0 = 1._dp
            else
                br_normalization_provided(1) = .true.
            end if
            if (b_0.ge.huge(1._dp)) then                                        ! user did not provide a value
                b_0 = 1._dp
            else
                br_normalization_provided(2) = .true.
            end if
            if (pres_0.ge.huge(1._dp)) then                                     ! user did not provide a value
                pres_0 = b_0**2/mu_0_original
            else
                nr_overridden_const = nr_overridden_const + 1
            end if
            if (psi_0.ge.huge(1._dp)) then                                      ! user did not provide a value
                psi_0 = r_0**2 * b_0
            else
                nr_overridden_const = nr_overridden_const + 1
            end if
            if (t_0.ge.huge(1._dp)) t_0 = sqrt(mu_0_original*rho_0)*r_0/b_0     ! only if user did not provide a value
        end subroutine calc_normalization_const_hel
        
        ! prints the Normalization factors
        subroutine print_normalization_const(R_0,rho_0,B_0,pres_0,psi_0,&
            &mu_0,T_0)
            ! input / output
            real(dp), intent(in), optional :: r_0
            real(dp), intent(in), optional :: rho_0
            real(dp), intent(in), optional :: b_0
            real(dp), intent(in), optional :: pres_0
            real(dp), intent(in), optional :: psi_0
            real(dp), intent(in), optional :: mu_0
            real(dp), intent(in), optional :: t_0
            
            ! user output
            if (present(r_0)) call writo('R_0    = '//trim(r2str(r_0))//' m')
            if (present(rho_0)) call writo('rho_0  = '//trim(r2str(rho_0))//&
                &' kg/m^3')
            if (present(b_0)) call writo('B_0    = '//trim(r2str(b_0))//' T')
            if (present(pres_0)) call writo('pres_0 = '//trim(r2str(pres_0))//&
                &' Pa')
            if (present(psi_0)) call writo('psi_0  = '//trim(r2str(psi_0))//&
                &' Tm^2')
            if (present(mu_0)) call writo('mu_0   = '//&
                &trim(r2str(mu_0))//' Tm/A')
            if (present(t_0)) call writo('T_0    = '//trim(r2str(t_0))//' s')
        end subroutine print_normalization_const
    end function calc_normalization_const
    
    subroutine normalize_input()
        use num_vars, only: use_normalization, eq_style, mu_0_original
        use vmec_ops, only: normalize_vmec
        use eq_vars, only: vac_perm
        
        ! only normalize if needed
        if (use_normalization) then
            ! user output
            call writo('Start normalizing the input variables')
            call lvl_ud(1)
            
            ! normalize common variables
            vac_perm = vac_perm/mu_0_original
            
            ! choose which equilibrium style is being used:
            !   1:  VMEC
            !   2:  HELENA
            select case (eq_style)
                case (1)                                                        ! VMEC
                    call normalize_vmec
                case (2)                                                        ! HELENA
                    ! other HELENA input already normalized
                    call writo('HELENA input is already normalized with MISHKA &
                        &normalization')
            end select
            
            ! user output
            call lvl_ud(-1)
            call writo('Normalization done')
        end if
    end subroutine normalize_input
    
    integer function b_plot(grid_eq,eq_1,eq_2,rich_lvl,plot_fluxes,XYZ) &
        &result(ierr)
        
        use grid_utilities, only: calc_vec_comp
        use eq_utilities, only: calc_inv_met
        use num_vars, only: eq_style, norm_disc_prec_eq, use_normalization
        use num_utilities, only: c
        use eq_vars, only: b_0
        
        character(*), parameter :: rout_name = 'B_plot'
        
        ! input / output
        type(grid_type), intent(inout) :: grid_eq
        type(eq_1_type), intent(in) :: eq_1
        type(eq_2_type), intent(in) :: eq_2
        integer, intent(in), optional :: rich_lvl
        logical, intent(in), optional :: plot_fluxes
        real(dp), intent(in), optional :: xyz(:,:,:,:)
        
        ! local variables
        integer :: id                                                           ! counter
        real(dp), allocatable :: b_com(:,:,:,:,:)                               ! covariant and contravariant components of B (dim1,dim2,dim3,3,2)
        real(dp), allocatable :: b_mag(:,:,:)                                   ! magnitude of B (dim1,dim2,dim3)
        real(dp), allocatable, save :: b_flux_tor(:,:), b_flux_pol(:,:)         ! fluxes
        character(len=10) :: base_name                                          ! base name
        logical :: plot_fluxes_loc                                              ! local plot_fluxes
        
        ! initialize ierr
        ierr = 0
        
        ! tests
        if (eq_style.eq.1 .and. .not.allocated(grid_eq%trigon_factors)) then
            ierr = 1
            chckerr('trigonometric factors not allocated')
        end if
        
        ! set up local plot_fluxes
        plot_fluxes_loc = .false.
        if (present(plot_fluxes)) plot_fluxes_loc = plot_fluxes
        
        ! set up components and magnitude of B
        allocate(b_com(grid_eq%n(1),grid_eq%n(2),grid_eq%loc_n_r,3,2))
        allocate(b_mag(grid_eq%n(1),grid_eq%n(2),grid_eq%loc_n_r))
        b_com = 0._dp
        b_mag = 0._dp
        do id = 1,3
            b_com(:,:,:,id,1) = eq_2%g_FD(:,:,:,c([3,id],.true.),0,0,0)/&
                &eq_2%jac_FD(:,:,:,0,0,0)
        end do
        b_com(:,:,:,3,2) = 1._dp/eq_2%jac_FD(:,:,:,0,0,0)
        
        ! transform back to unnormalized quantity
        if (use_normalization) b_com = b_com * b_0
        
        ! set plot variables
        base_name = 'B'
        if (present(rich_lvl)) then
            if (rich_lvl.gt.0) base_name = trim(base_name)//'_R_'//&
                &trim(i2str(rich_lvl))
        end if
        
        ! transform coordinates, including the flux
        if (plot_fluxes_loc) then
            ierr = calc_vec_comp(grid_eq,grid_eq,eq_1,eq_2,b_com,&
                &norm_disc_prec_eq,v_mag=b_mag,base_name=base_name,&
                &v_flux_tor=b_flux_tor,v_flux_pol=b_flux_pol,xyz=xyz)
            chckerr('')
        else
            ierr = calc_vec_comp(grid_eq,grid_eq,eq_1,eq_2,b_com,&
                &norm_disc_prec_eq,v_mag=b_mag,base_name=base_name,xyz=xyz)
            chckerr('')
        end if
    end function b_plot
    
    integer function j_plot(grid_eq,eq_1,eq_2,rich_lvl,plot_fluxes,XYZ) &
        &result(ierr)
        
        use grid_utilities, only: calc_vec_comp
        use eq_utilities, only: calc_inv_met
        use num_vars, only: eq_style, norm_disc_prec_eq, use_normalization
        use num_utilities, only: c
        use eq_vars, only: b_0, r_0, pres_0
#if ldebug
        use eq_vars, only: max_flux_f
        use vmec_vars, only: j_v_sup_int
        use num_utilities, only: calc_int
#endif
        
        character(*), parameter :: rout_name = 'J_plot'
        
        ! input / output
        type(grid_type), intent(inout) :: grid_eq
        type(eq_1_type), intent(in) :: eq_1
        type(eq_2_type), intent(in) :: eq_2
        integer, intent(in), optional :: rich_lvl
        logical, intent(in), optional :: plot_fluxes
        real(dp), intent(in), optional :: xyz(:,:,:,:)
        
        ! local variables
        integer :: id, kd                                                       ! counters
        real(dp), allocatable :: j_com(:,:,:,:,:)                               ! covariant and contravariant components of J (dim1,dim2,dim3,3,2)
        real(dp), allocatable :: j_mag(:,:,:)                                   ! magnitude of J (dim1,dim2,dim3)
        character(len=10) :: base_name                                          ! base name
        real(dp), allocatable, save :: j_flux_tor(:,:), j_flux_pol(:,:)         ! fluxes
        logical :: plot_fluxes_loc                                              ! local plot_fluxes
        character(len=max_str_ln) :: plot_name                                  ! name of plot
        character(len=max_str_ln) :: plot_titles(2)                             ! titles of plot
#if ldebug
        real(dp), allocatable :: j_v_sup_int2(:,:)                              ! integrated J_V_sup_int
#endif
        
        ! initialize ierr
        ierr = 0
        
        ! tests
        if (eq_style.eq.1 .and. .not.allocated(grid_eq%trigon_factors)) then
            ierr = 1
            chckerr('trigonometric factors not allocated')
        end if
        
        ! set up local plot_fluxes
        plot_fluxes_loc = .false.
        if (present(plot_fluxes)) plot_fluxes_loc = plot_fluxes
        
        ! set up components and magnitude of J
        allocate(j_com(grid_eq%n(1),grid_eq%n(2),grid_eq%loc_n_r,3,2))
        allocate(j_mag(grid_eq%n(1),grid_eq%n(2),grid_eq%loc_n_r))
        j_com = 0._dp
        j_mag = 0._dp
#if ldebug
        if (debug_j_plot) then
            j_com(:,:,:,1,2) = eq_2%g_FD(:,:,:,c([3,3],.true.),0,1,0) - &
                &eq_2%g_FD(:,:,:,c([3,3],.true.),0,0,0)*&
                &eq_2%jac_FD(:,:,:,0,1,0)/&
                &eq_2%jac_FD(:,:,:,0,0,0) - &
                &eq_2%g_FD(:,:,:,c([2,3],.true.),0,0,1) + &
                &eq_2%g_FD(:,:,:,c([2,3],.true.),0,0,0)*&
                &eq_2%jac_FD(:,:,:,0,0,1)/&
                &eq_2%jac_FD(:,:,:,0,0,0) 
            j_com(:,:,:,1,2) = j_com(:,:,:,1,2)/eq_2%jac_FD(:,:,:,0,0,0)**2
            j_com(:,:,:,3,2) = eq_2%g_FD(:,:,:,c([2,3],.true.),1,0,0) - &
                &eq_2%g_FD(:,:,:,c([2,3],.true.),0,0,0)*&
                &eq_2%jac_FD(:,:,:,1,0,0)/&
                &eq_2%jac_FD(:,:,:,0,0,0) - &
                &eq_2%g_FD(:,:,:,c([1,3],.true.),0,1,0) + &
                &eq_2%g_FD(:,:,:,c([1,3],.true.),0,0,0)*&
                &eq_2%jac_FD(:,:,:,0,1,0)/&
                &eq_2%jac_FD(:,:,:,0,0,0) 
            j_com(:,:,:,3,2) = j_com(:,:,:,3,2)/eq_2%jac_FD(:,:,:,0,0,0)**2
        else
#endif
            do kd = 1,grid_eq%loc_n_r
                j_com(:,:,kd,1,2) = -eq_1%pres_FD(kd,1)
                j_com(:,:,kd,3,2) = eq_2%sigma(:,:,kd)/&
                    &eq_2%jac_FD(:,:,kd,0,0,0) + eq_1%pres_FD(kd,1)*&
                    &eq_2%g_FD(:,:,kd,c([1,3],.true.),0,0,0) / &
                    &eq_2%g_FD(:,:,kd,c([3,3],.true.),0,0,0)
            end do
#if ldebug
        end if
#endif
        do id = 1,3
            j_com(:,:,:,id,1) = &
                &j_com(:,:,:,1,2)*eq_2%g_FD(:,:,:,c([1,id],.true.),0,0,0) + &
                &j_com(:,:,:,3,2)*eq_2%g_FD(:,:,:,c([3,id],.true.),0,0,0)
        end do
        
        ! transform back to unnormalized quantity
        if (use_normalization) j_com = j_com * pres_0/(r_0*b_0)
        
        ! set plot variables
        base_name = 'J'
        if (present(rich_lvl)) then
            if (rich_lvl.gt.0) base_name = trim(base_name)//'_R_'//&
                &trim(i2str(rich_lvl))
        end if
        
        ! transform coordinates, including the flux
        if (plot_fluxes_loc) then
            ierr = calc_vec_comp(grid_eq,grid_eq,eq_1,eq_2,j_com,&
                &norm_disc_prec_eq,v_mag=j_mag,base_name=base_name,&
                &v_flux_tor=j_flux_tor,v_flux_pol=j_flux_pol,xyz=xyz)
            chckerr('')
        else
            ierr = calc_vec_comp(grid_eq,grid_eq,eq_1,eq_2,j_com,&
                &norm_disc_prec_eq,v_mag=j_mag,base_name=base_name,xyz=xyz)
            chckerr('')
        end if
        
#if ldebug
        if (eq_style.eq.1) then
            ! transform back to unnormalized quantity
            if (use_normalization) j_v_sup_int = j_v_sup_int * pres_0/(r_0*b_0)
            
            ! plot the fluxes from VMEC
            plot_name = 'J_V_sup_int'
            plot_titles = ['J^theta_V','J^phi_V  ']
            call print_ex_2d(plot_titles,plot_name,j_v_sup_int,&
                &x=reshape(grid_eq%r_F*2*pi/max_flux_f,&
                &[size(grid_eq%r_F),1]),draw=.false.)
            call draw_ex(plot_titles,plot_name,2,1,.false.)
            
            ! integrate
            allocate(j_v_sup_int2(size(j_v_sup_int,1),2))
            do id = 1,2
                ierr = calc_int(j_v_sup_int(:,id),grid_eq%r_E,&
                    &j_v_sup_int2(:,id))
                chckerr('')
            end do
            plot_name = 'J_V_sup_int2'
            plot_titles = ['J^theta_V','J^phi_V  ']
            call print_ex_2d(plot_titles,plot_name,j_v_sup_int2,&
                &x=reshape(grid_eq%r_F*2*pi/max_flux_f,&
                &[size(grid_eq%r_F),1]),draw=.false.)
            call draw_ex(plot_titles,plot_name,2,1,.false.)
        end if
#endif
    end function j_plot
    
    integer function kappa_plot(grid_eq,eq_1,eq_2,rich_lvl,XYZ) &
        &result(ierr)
        
        use grid_utilities, only: calc_vec_comp
        use eq_vars, only: eq_1_type, eq_2_type
        use eq_utilities, only: calc_inv_met
        use num_vars, only: eq_style, norm_disc_prec_eq, use_normalization
        use num_utilities, only: c
        use eq_vars, only: r_0
        use vmec_utilities, only: calc_trigon_factors
#if ldebug
        use num_vars, only: ltest, eq_jobs_lims, eq_job_nr
        use input_utilities, only: get_log
        use grid_utilities, only: trim_grid, calc_xyz_grid
#endif
        
        character(*), parameter :: rout_name = 'kappa_plot'
        
        ! input / output
        type(grid_type), intent(inout) :: grid_eq
        type(eq_1_type), intent(in) :: eq_1
        type(eq_2_type), intent(in) :: eq_2
        integer, intent(in), optional :: rich_lvl
        real(dp), intent(in), optional :: xyz(:,:,:,:)
        
        ! local variables
        real(dp), allocatable :: k_com(:,:,:,:,:)                               ! covariant and contravariant components of kappa (dim1,dim2,dim3,3,2)
        real(dp), allocatable :: k_mag(:,:,:)                                   ! magnitude of kappa (dim1,dim2,dim3)
        character(len=15) :: base_name                                          ! base name
#if ldebug
        type(grid_type) :: grid_trim                                            ! trimmed equilibrium grid
        integer :: id                                                           ! counter
        integer :: norm_id(2)                                                   ! untrimmed normal indices for trimmed grids
        integer :: plot_dim(4)                                                  ! dimensions of plot
        integer :: plot_offset(4)                                               ! local offset of plot
        real(dp), allocatable :: xyz_loc(:,:,:,:,:)                             ! X, Y and Z of surface in cylindrical coordinates, trimmed grid
        real(dp), allocatable :: k_com_inv(:,:,:,:)                             ! inverted cartesian components of curvature
        logical, save :: asked_for_testing = .false.                            ! whether we have been asked to test
        logical, save :: testing = .false.                                      ! whether we are testing
#endif
        
        ! initialize ierr
        ierr = 0
        
        ! tests
        if (eq_style.eq.1 .and. .not.allocated(grid_eq%trigon_factors)) then
            ierr = 1
            chckerr('trigonometric factors not allocated')
        end if
        
        ! set up components and magnitude of kappa
        allocate(k_com(grid_eq%n(1),grid_eq%n(2),grid_eq%loc_n_r,3,2))
        allocate(k_mag(grid_eq%n(1),grid_eq%n(2),grid_eq%loc_n_r))
        k_com = 0._dp
        k_mag = 0._dp
        
        ! covariant components:
        !   kappa . e_alpha = kappa_g 
        !   kappa . e_psi   = kappa_n - kappa_g h12/h22
        !   kappa . e_theta = 0
        ! and similar for Q
        k_com(:,:,:,1,1) = eq_2%kappa_g
        k_com(:,:,:,2,1) = eq_2%kappa_n - &
            &eq_2%kappa_g * &
            &eq_2%h_FD(:,:,:,c([1,2],.true.),0,0,0)/&
            &eq_2%h_FD(:,:,:,c([2,2],.true.),0,0,0)
        k_com(:,:,:,3,1) = 0._dp
        
        ! contravariant components:
        !   kappa . nabla alpha = kappa_n h12 + kappa_g g33/(J^2 h22)
        !   kappa . nabla psi   = kappa_n h22
        !   kappa . nabla theta = kappa_n h23 - kappa_g g13/(J^2 h22)
        ! and similar for Q
        k_com(:,:,:,1,2) = eq_2%kappa_n * &
            &eq_2%h_FD(:,:,:,c([1,2],.true.),0,0,0) + &
            &eq_2%kappa_g * &
            &eq_2%g_FD(:,:,:,c([3,3],.true.),0,0,0) / &
            &(eq_2%jac_FD(:,:,:,0,0,0)**2*&
            &eq_2%h_FD(:,:,:,c([2,2],.true.),0,0,0))
        k_com(:,:,:,2,2) = eq_2%kappa_n * &
            &eq_2%h_FD(:,:,:,c([2,2],.true.),0,0,0)
        k_com(:,:,:,3,2) = eq_2%kappa_n * &
            &eq_2%h_FD(:,:,:,c([3,2],.true.),0,0,0) - &
            &eq_2%kappa_g * &
            &eq_2%g_FD(:,:,:,c([3,1],.true.),0,0,0) / &
            &(eq_2%jac_FD(:,:,:,0,0,0)**2*&
            &eq_2%h_FD(:,:,:,c([2,2],.true.),0,0,0))
        
        ! transform back to unnormalized quantity
        if (use_normalization) k_com = k_com / r_0
        
        ! set plot variables
        base_name = 'kappa'
        if (present(rich_lvl)) then
            if (rich_lvl.gt.0) base_name = trim(base_name)//'_R_'//&
                &trim(i2str(rich_lvl))
        end if
        
        ! transform coordinates
        ierr = calc_vec_comp(grid_eq,grid_eq,eq_1,eq_2,k_com,&
            &norm_disc_prec_eq,v_mag=k_mag,base_name=base_name,xyz=xyz)
        chckerr('')
        
#if ldebug
        if (ltest) then
            if (.not.asked_for_testing) then
                call writo('Do you want to plot the inversion in kappa?')
                call lvl_ud(1)
                testing = get_log(.false.)
                asked_for_testing = .true.
                call lvl_ud(-1)
            end if
            if (testing) then
                call writo('Every point in the grid is transformed by &
                    &displacing it in the direction of the curvature,')
                call writo('by a distance equal to the inverse of the &
                    &curvature. I.e. the point is displaced to the center &
                    &of curvature.')
                call lvl_ud(1)
                
                ! trim equilibrium grid
                ierr = trim_grid(grid_eq,grid_trim,norm_id)
                chckerr('')
                
                ! set up plot dimensions and local dimensions
                plot_dim = [grid_trim%n,3]
                plot_offset = [0,0,grid_trim%i_min-1,0]
                
                ! possibly modify if multiple equilibrium parallel jobs
                if (size(eq_jobs_lims,2).gt.1) then
                    plot_dim(1) = eq_jobs_lims(2,size(eq_jobs_lims,2)) - &
                        &eq_jobs_lims(1,1) + 1
                    plot_offset(1) = eq_jobs_lims(1,eq_job_nr) - 1
                end if
                
                ! set up inverted cartesian components
                allocate(k_com_inv(grid_trim%n(1),grid_trim%n(2),&
                    &grid_trim%loc_n_r,3))
                do id = 1,3
                    k_com_inv(:,:,:,id) = &
                        &k_com(:,:,norm_id(1):norm_id(2),id,1)/&
                        &(k_mag(:,:,norm_id(1):norm_id(2))**2)
                end do
                
                ! if VMEC, calculate trigonometric factors of trimmed grid
                if (eq_style.eq.1) then
                    ierr = calc_trigon_factors(grid_trim%theta_E,&
                        &grid_trim%zeta_E,grid_trim%trigon_factors)
                    chckerr('')
                end if
                
                ! calculate X, Y and Z
                allocate(xyz_loc(grid_trim%n(1),grid_trim%n(2),&
                    &grid_trim%loc_n_r,3,3))
                ierr = calc_xyz_grid(grid_eq,grid_trim,xyz_loc(:,:,:,1,1),&
                    &xyz_loc(:,:,:,1,2),xyz_loc(:,:,:,1,3))
                chckerr('')
                
                ! produce a plot of center of curvature for every point
                call plot_hdf5(['cen_of_curv'],'TEST_cen_of_curv_vec',&
                    &k_com_inv,tot_dim=plot_dim,loc_offset=plot_offset,&
                    &x=xyz_loc(:,:,:,:,1),y=xyz_loc(:,:,:,:,2),&
                    &z=xyz_loc(:,:,:,:,3),col=4,cont_plot=eq_job_nr.gt.1,&
                    &descr='center of curvature')
                
                ! displace the points to the center of curvature
                do id = 1,3
                    xyz_loc(:,:,:,1,id) = xyz_loc(:,:,:,1,id) + &
                        &k_com_inv(:,:,:,id)
                end do
                xyz_loc(:,:,:,2,:) = xyz_loc(:,:,:,1,:)
                xyz_loc(:,:,:,3,:) = xyz_loc(:,:,:,3,:)
                
                ! produce an inverted plot
                call plot_hdf5(['cen_of_curv_inv'],'TEST_cen_of_curv_inv_vec',&
                    &-k_com_inv,tot_dim=plot_dim,loc_offset=plot_offset,&
                    &x=xyz_loc(:,:,:,:,1),y=xyz_loc(:,:,:,:,2),&
                    &z=xyz_loc(:,:,:,:,3),col=4,cont_plot=eq_job_nr.gt.1,&
                    &descr='center of curvature')
                
                ! clean up
                call grid_trim%dealloc()
                
                call lvl_ud(-1)
            end if
        end if
#endif
    end function kappa_plot
    
    integer function delta_r_plot(grid_eq,eq_1,eq_2,XYZ,rich_lvl) &
        &result(ierr)
        
        use grid_utilities, only: calc_vec_comp, calc_xyz_grid, trim_grid, &
            &calc_tor_diff, nufft
        use eq_utilities, only: calc_inv_met
        use num_vars, only: eq_style, norm_disc_prec_eq, eq_job_nr, rz_0, &
            &use_normalization, rank, ex_plot_style, n_procs, prop_b_tor_i, &
            &tol_zero
        use eq_vars, only: b_0
        use num_utilities, only: c, calc_int, order_per_fun
        use mpi_utilities, only: get_ser_var
        
        character(*), parameter :: rout_name = 'delta_r_plot'
        
        ! input / output
        type(grid_type), intent(inout) :: grid_eq
        type(eq_1_type), intent(in) :: eq_1
        type(eq_2_type), intent(in) :: eq_2
        real(dp), intent(in) :: xyz(:,:,:,:)
        integer, intent(in), optional :: rich_lvl
        
        ! local variables
        integer :: id, kd                                                       ! counters
        integer :: norm_id(2)                                                   ! untrimmed normal indices for trimmed grids
        integer :: r_lim_2d(2)                                                  ! limits of r to plot in 2-D
        integer :: max_m                                                        ! maximum mode number
        real(dp), allocatable :: xyz_loc(:,:,:,:)                               ! X, Y and Z of surface in trimmed grid
        real(dp), allocatable :: b_com(:,:,:,:,:)                               ! covariant and contravariant components of B (dim1,dim2,dim3,3,2)
        real(dp), allocatable :: delta_b_tor(:,:,:)                             ! delta_B/B
        real(dp), allocatable :: prop_b_tor_tot(:,:)                            ! delta_r / delta_B/B in total grid
        real(dp), allocatable :: prop_b_tor(:,:,:)                              ! delta_r / delta_B/B
        real(dp), allocatable :: var_tot_loc(:)                                 ! auxilliary variable
        real(dp), allocatable :: x_2d(:,:)                                      ! x for 2-D plotting
        real(dp), allocatable :: delta_r(:,:,:)                                 ! normal displacement
        real(dp), allocatable :: theta_geo(:,:,:)                               ! geometrical poloidal angle for proportionality factor output
        real(dp), allocatable :: r_geo(:,:,:)                                   ! geometrical radius for proportionality factor output
        real(dp), allocatable :: prop_b_tor_plot(:,:)                           ! prop_B_tor and angle at last normal position for plotting
        real(dp), allocatable :: delta_r_f(:,:)                                 ! Fourier components of delta_r at last normal position
        logical :: new_file_found                                               ! name for new file found
        character(len=25) :: base_name                                          ! base name
        character(len=25) :: plot_name                                          ! plot name
        character(len=max_str_ln) :: prop_b_tor_file_name                       ! name of B_tor proportionality file
        type(grid_type) :: grid_trim                                            ! trimmed equilibrium grid
        
        ! initialize ierr
        ierr = 0
        
        ! tests
        if (eq_style.eq.1 .and. .not.allocated(grid_eq%trigon_factors)) then
            ierr = 1
            chckerr('trigonometric factors not allocated')
        end if
        
        call writo('Calculate normal displacement')
        call lvl_ud(1)
        
        ! trim grid
        ierr = trim_grid(grid_eq,grid_trim,norm_id)
        chckerr('')
        
        ! calculate local X, Y and Z
        ! (Can be different from provided one for different plot grid styles)
        allocate(xyz_loc(grid_eq%n(1),grid_eq%n(2),grid_eq%loc_n_r,4))
        ierr = calc_xyz_grid(grid_eq,grid_eq,xyz_loc(:,:,:,1),xyz_loc(:,:,:,2),&
            &xyz_loc(:,:,:,3),r=xyz_loc(:,:,:,4))
        chckerr('')
        
        ! calculate geometrical poloidal angle and radius
        allocate(theta_geo(grid_eq%n(1),grid_eq%n(2),grid_eq%loc_n_r))
        allocate(r_geo(grid_eq%n(1),grid_eq%n(2),grid_eq%loc_n_r))
        theta_geo = atan2(xyz_loc(:,:,:,3)-rz_0(2),&
            &xyz_loc(:,:,:,4)-rz_0(1))
        where (theta_geo.lt.0._dp) theta_geo = theta_geo + 2*pi
        r_geo = sqrt((xyz_loc(:,:,:,3)-rz_0(2))**2 + &
            &(xyz_loc(:,:,:,4)-rz_0(1))**2)
        
        ! plot
        call plot_hdf5('theta_geo','theta_geo',&
            &theta_geo(:,:,norm_id(1):norm_id(2)),&
            &tot_dim=[grid_trim%n(1),grid_trim%n(2),grid_trim%n(3)],&
            &loc_offset=[0,0,grid_trim%i_min-1],&
            &x=xyz(:,:,norm_id(1):norm_id(2),1),&
            &y=xyz(:,:,norm_id(1):norm_id(2),2),&
            &z=xyz(:,:,norm_id(1):norm_id(2),3),cont_plot=eq_job_nr.gt.1,&
            &descr='geometrical poloidal angle')
        call plot_hdf5('r_geo','r_geo',&
            &r_geo(:,:,norm_id(1):norm_id(2)),&
            &tot_dim=[grid_trim%n(1),grid_trim%n(2),grid_trim%n(3)],&
            &loc_offset=[0,0,grid_trim%i_min-1],&
            &x=xyz(:,:,norm_id(1):norm_id(2),1),&
            &y=xyz(:,:,norm_id(1):norm_id(2),2),&
            &z=xyz(:,:,norm_id(1):norm_id(2),3),cont_plot=eq_job_nr.gt.1,&
            &descr='geometrical radius')
        
        ! calculate perturbation delta_r on radius
        ierr = calc_tor_diff(r_geo,theta_geo,norm_disc_prec_eq,&
            &absolute=.true.,r=grid_eq%loc_r_F)
        chckerr('')
        allocate(delta_r(grid_eq%n(1),1,grid_eq%loc_n_r))
        delta_r(:,1,:) = r_geo(:,2,:)*0.5_dp                                    ! take factor half as this is absolute
        deallocate(r_geo)
        
        ! set plot variables for delta_r
        base_name = 'delta_r'
        plot_name = 'delta_r'
        if (present(rich_lvl)) then
            if (rich_lvl.gt.0) base_name = trim(base_name)//'_R_'//&
                &trim(i2str(rich_lvl))
        end if
        
        ! plot
        call plot_hdf5(trim(plot_name),trim(base_name),&
            &delta_r(:,:,norm_id(1):norm_id(2)),&
            &tot_dim=[grid_trim%n(1),1,grid_trim%n(3)],&
            &loc_offset=[0,0,grid_trim%i_min-1],&
            &x=xyz(:,2:2,norm_id(1):norm_id(2),1),&
            &y=xyz(:,2:2,norm_id(1):norm_id(2),2),&
            &z=xyz(:,2:2,norm_id(1):norm_id(2),3),&
            &cont_plot=eq_job_nr.gt.1,&
            &descr='plasma position displacement')
        
        ! calculate NUFFT for last point
        if (rank.eq.n_procs-1) then
            ! plot delta_r at last normal position
            call print_ex_2d(trim(plot_name),trim(base_name),&
                &delta_r(1:grid_eq%n(1)-1,1,grid_eq%loc_n_r),&
                &x=theta_geo(1:grid_eq%n(1)-1,2,grid_eq%loc_n_r),&
                &draw=.false.)
            call draw_ex([trim(plot_name)],trim(base_name),1,1,.false.)
            
            ! calculate and plot Fourier modes
            ierr = nufft(theta_geo(1:grid_eq%n(1)-1,2,grid_eq%loc_n_r),&
                &delta_r(1:grid_eq%n(1)-1,1,grid_eq%loc_n_r),delta_r_f)
            chckerr('')
            base_name = trim(base_name)//'_F'
            call print_ex_2d(['delta_r cos','delta_r sin'],trim(base_name),&
                &delta_r_f,draw=.false.)
            call draw_ex(['delta_r cos','delta_r sin'],trim(base_name),2,1,&
                &.false.)
            
            ! mode outputs, (p)recycle "prop_B_tor_file_*"
            new_file_found = .false.
            prop_b_tor_file_name = base_name
            kd = 1
            do while (.not.new_file_found)
                open(prop_b_tor_i,file=trim(prop_b_tor_file_name)//'_'//&
                    &trim(i2str(kd))//'.dat',iostat=ierr,status='old')
                if (ierr.eq.0) then
                    kd = kd + 1
                else
                    prop_b_tor_file_name = trim(prop_b_tor_file_name)//&
                        &'_'//trim(i2str(kd))//'.dat'
                    new_file_found = .true.
                    open(prop_b_tor_i,file=trim(prop_b_tor_file_name),&
                        &iostat=ierr,status='new')
                    chckerr('Failed to open file')
                end if
            end do
            
            ! write to output file
            max_m = 20
            write(prop_b_tor_i,'("# ",2(A5," "),2(A23," "))') &
                &'N', 'M', 'delta_c', 'delta_s'
            do id = 1,min(size(delta_r_f,1),max_m+1)
                write(prop_b_tor_i,'("  ",2(I5," "),2(ES23.16," "))') &
                    &18, id-1, delta_r_f(id,:)
            end do
            
            ! close
            close(prop_b_tor_i)
        end if
        
        call lvl_ud(-1)
        
        call writo('Calculate magnetic field ripple')
        call lvl_ud(1)
        
        ! Calculate cylindrical components of B
        allocate(b_com(grid_eq%n(1),grid_eq%n(2),grid_eq%loc_n_r,3,2))
        b_com = 0._dp
        do id = 1,3
            b_com(:,:,:,id,1) = eq_2%g_FD(:,:,:,c([3,id],.true.),0,0,0)/&
                &eq_2%jac_FD(:,:,:,0,0,0)
        end do
        b_com(:,:,:,3,2) = 1._dp/eq_2%jac_FD(:,:,:,0,0,0)
        if (use_normalization) b_com = b_com * b_0
        ierr = calc_vec_comp(grid_eq,grid_eq,eq_1,eq_2,b_com,norm_disc_prec_eq,&
            &max_transf=4)
        chckerr('')
        
        ! calculate perturbation
        ierr = calc_tor_diff(b_com,theta_geo,norm_disc_prec_eq,&
            &r=grid_eq%loc_r_F)
        chckerr('')
        allocate(delta_b_tor(grid_eq%n(1),1,grid_eq%loc_n_r))
        delta_b_tor(:,1,:) = 0.5_dp*sum(b_com(:,2,:,2,:),3)
        deallocate(b_com)
        
        ! set plot variables for delta_B_tor
        base_name = 'delta_B_tor'
        plot_name = 'delta_B_tor'
        if (present(rich_lvl)) then
            if (rich_lvl.gt.0) base_name = trim(base_name)//'_R_'//&
                &trim(i2str(rich_lvl))
        end if
        
        ! plot with HDF5
        call plot_hdf5(trim(plot_name),trim(base_name),&
            &delta_b_tor(:,:,norm_id(1):norm_id(2)),&
            &tot_dim=[grid_trim%n(1),1,grid_trim%n(3)],&
            &loc_offset=[0,0,grid_trim%i_min-1],&
            &x=xyz(:,2:2,norm_id(1):norm_id(2),1),&
            &y=xyz(:,2:2,norm_id(1):norm_id(2),2),&
            &z=xyz(:,2:2,norm_id(1):norm_id(2),3),cont_plot=eq_job_nr.gt.1,&
            &descr='plasma position displacement')
        
        call lvl_ud(-1)
        
        call writo('Calculate proportionality factor')
        call lvl_ud(1)
        
        allocate(prop_b_tor(grid_eq%n(1),1,grid_eq%loc_n_r))
        prop_b_tor = 0.0_dp
        where (abs(delta_b_tor).gt.tol_zero) prop_b_tor = delta_r / delta_b_tor
        
        ! set plot variables for prop_B_tor
        base_name = 'prop_B_tor'
        plot_name = trim(base_name)
        if (present(rich_lvl)) then
            if (rich_lvl.gt.0) base_name = trim(base_name)//'_R_'//&
                &trim(i2str(rich_lvl))
        end if
        
        ! plot with HDF5
        call plot_hdf5(plot_name,trim(base_name),&
            &prop_b_tor(:,:,norm_id(1):norm_id(2)),&
            &tot_dim=[grid_trim%n(1),1,grid_trim%n(3)],&
            &loc_offset=[0,0,grid_trim%i_min-1],&
            &x=xyz(:,2:2,norm_id(1):norm_id(2),1),&
            &y=xyz(:,2:2,norm_id(1):norm_id(2),2),&
            &z=xyz(:,2:2,norm_id(1):norm_id(2),3),&
            &cont_plot=eq_job_nr.gt.1,&
            &descr='delta_r divided by delta_B_tor')
        
        ! plot in 2-D
        r_lim_2d = [1,grid_trim%n(3)]
        if (ex_plot_style.eq.2) r_lim_2d(1) = &
            &max(r_lim_2d(1),r_lim_2d(2)-127+1)                                 ! Bokeh can only handle 255/2 input arguments
        if (rank.eq.0) then
            allocate(x_2d(grid_trim%n(1),grid_trim%n(3)))
        end if
        allocate(prop_b_tor_tot(grid_trim%n(1),grid_trim%n(3)))
        do id = 1,grid_trim%n(1)
            ! prop_B_tor (all procs)
            ierr = get_ser_var(prop_b_tor(id,1,norm_id(1):norm_id(2)),&
                &var_tot_loc,scatter=.true.)
            chckerr('')
            prop_b_tor_tot(id,:) = max(min(var_tot_loc,2._dp),-2._dp)           ! limit to avoid division by small delta_B_tor values
            deallocate(var_tot_loc)
            
            ! theta_geo (only master)
            ierr = get_ser_var(theta_geo(id,2,norm_id(1):norm_id(2)),&
                &var_tot_loc)
            chckerr('')
            if (rank.eq.0) x_2d(id,:) = var_tot_loc/pi
            deallocate(var_tot_loc)
        end do
        if (rank.eq.0) then
            call print_ex_2d([trim(plot_name)],trim(base_name),&
                &prop_b_tor_tot(:,r_lim_2d(1):r_lim_2d(2)),&
                &x=x_2d(:,r_lim_2d(1):r_lim_2d(2)),draw=.false.)
            call draw_ex([trim(plot_name)],trim(base_name),&
                &r_lim_2d(2)-r_lim_2d(1)+1,1,.false.)
        end if
        
        call lvl_ud(-1)
        
        call writo('Output to file as function of poloidal flux angle')
        call lvl_ud(1)
        
        ! only last rank outputs to file (it has the last normal position)
        if (rank.eq.n_procs-1) then
            ! find new file name
            new_file_found = .false.
            prop_b_tor_file_name = 'prop_B_tor'
            kd = 1
            do while (.not.new_file_found)
                open(prop_b_tor_i,file=trim(prop_b_tor_file_name)//'_'//&
                    &trim(i2str(kd))//'.dat',iostat=ierr,status='old')
                if (ierr.eq.0) then
                    kd = kd + 1
                else
                    prop_b_tor_file_name = trim(prop_b_tor_file_name)//&
                        &'_'//trim(i2str(kd))//'.dat'
                    new_file_found = .true.
                    open(prop_b_tor_i,file=trim(prop_b_tor_file_name),&
                        &iostat=ierr,status='new')
                    chckerr('Failed to open file')
                end if
            end do
            
            ! user output
            call writo('Save toroidal field proportionality factor in &
                &file "'//trim(prop_b_tor_file_name)//'"',persistent=.true.)
            
            ! order  output, taking away last  point as it is  equivalent to
            ! the first
            ierr = order_per_fun(reshape([&
                &theta_geo(1:grid_trim%n(1)-1,1,grid_trim%loc_n_r),&
                &prop_b_tor_tot(1:grid_trim%n(1)-1,grid_trim%n(3))],&
                &[grid_trim%n(1)-1,2]),prop_b_tor_plot,0)
            chckerr('')
            
            ! write to output file
            write(prop_b_tor_i,'("# ",2(A23," "))') &
                &'pol. angle [ ]', 'prop. factor [ ]'
            do id = 1,grid_trim%n(1)-1
                write(prop_b_tor_i,'("  ",2(ES23.16," "))') &
                    &prop_b_tor_plot(id,:)
            end do
            
            ! close
            close(prop_b_tor_i)
        end if
        
        call lvl_ud(-1)
        
        ! clean up
        call grid_trim%dealloc()
    end function delta_r_plot
 
    integer function divide_eq_jobs(n_par_X,arr_size,n_div,n_div_max,&
        &n_par_X_base,range_name) result(ierr)
        
        use num_vars, only: max_tot_mem, max_x_mem, magn_int_style, &
            &mem_scale_fac, prog_style
        use rich_vars, only: rich_lvl
        use eq_utilities, only: calc_memory_eq
        use x_utilities, only: calc_memory_x
        use x_vars, only: n_mod_x
        
        character(*), parameter :: rout_name = 'divide_eq_jobs'
        
        ! input / output
        integer, intent(in) :: n_par_x
        integer, intent(in) :: arr_size(2)
        integer, intent(inout) :: n_div
        integer, intent(in), optional :: n_div_max
        integer, intent(in), optional :: n_par_x_base
        character(len=*), intent(in), optional :: range_name
        
        ! local variables
        real(dp) :: mem_size(2)                                                 ! approximation of memory required for eq_2 and X_1 variables
        integer :: n_par_x_base_loc                                             ! local n_par_X_base
        integer :: max_mem_req                                                  ! maximum memory required
        integer :: n_div_max_loc                                                ! maximum n_div
        integer :: n_par_range                                                  ! nr. of points in range
        character(len=max_str_ln) :: range_message                              ! message about how many ranges
        character(len=max_str_ln) :: err_msg                                    ! error message
        character(len=max_str_ln) :: range_name_loc                             ! local range name
        
        ! initialize ierr
        ierr = 0
        
        ! user output
        call writo('Dividing the equilibrium jobs')
        call lvl_ud(1)
        
        ! set up width of fundamental interval
        select case (magn_int_style)
            case (1)                                                            ! Trapezoidal rule
                fund_n_par = 1   
            case (2)                                                            ! Simpson's 3/8 rule
                fund_n_par = 3   
        end select
        
        ! set up local n_par_X_base
        n_par_x_base_loc = 0
        if (present(n_par_x_base)) n_par_x_base_loc = n_par_x_base
        
        ! set up local range name
        range_name_loc = 'parallel points'
        if (present(range_name)) range_name_loc = trim(range_name)
        
        ! setup auxilliary variables
        n_div = 0
        mem_size = huge(1._dp)*0.49_dp
        if (rich_lvl.eq.1) then
            n_div_max_loc = (n_par_x-1)/fund_n_par
        else
            n_div_max_loc = n_par_x/fund_n_par
        end if
        if (present(n_div_max)) n_div_max_loc = n_div_max
        n_div_max_loc = max(1,n_div_max_loc)                                    ! cannot have less than 1 piece
        
        ! calculate largest possible range of parallel points fitting in memory
        do while (max_tot_mem.lt.sum(mem_size))                                 ! combined mem_size has to be smaller than total memory
            n_div = n_div + 1
            n_par_range = ceiling(n_par_x*1._dp/n_div + n_par_x_base_loc)
            ierr = calc_memory_eq(arr_size(1),n_par_range,mem_size(1))
            chckerr('')
            mem_size(1) = mem_size(1)*mem_scale_fac                             ! operations have to be done on eq, it is not just stored.
            ierr = calc_memory_x(1,arr_size(2)*n_par_range,n_mod_x,mem_size(2)) ! all modes have to be stored
            chckerr('')
            if (n_div.gt.n_div_max_loc) then                                    ! still not enough memory
                ierr = 1
                err_msg = 'The memory limit is too low, need more than '//&
                    &trim(i2str(max_mem_req))//'MB'
                chckerr(err_msg)
            end if
            max_mem_req = ceiling(sum(mem_size))
        end do
        if (n_div.gt.1) then
            range_message = 'The '//trim(i2str(n_par_x))//' '//&
                &trim(range_name_loc)//' are split into '//&
                &trim(i2str(n_div))//' and '//trim(i2str(n_div))//&
                &' collective jobs are done serially'
        else
            range_message = 'The '//trim(i2str(n_par_x))//' '//&
                &trim(range_name_loc)//' can be done without splitting them'
        end if
        call writo(range_message)
        call writo('The total memory for all processes together is estimated &
            &to be about '//trim(i2str(ceiling(sum(mem_size))))//'MB')
        call lvl_ud(1)
        call writo('(maximum: '//trim(i2str(ceiling(max_tot_mem)))//'&
            &MB, user specified)')
        call lvl_ud(-1)
        
        if (prog_style.eq.1) then
            ! calculate max memory available for perturbation calculations
            mem_size(1) = mem_size(1)/mem_scale_fac                             ! rescale by mem_scale_fac as eq is now just stored
            max_x_mem = max_tot_mem - sum(mem_size)
            call writo('In the perturbation phase, the equilibrium variables &
                &are not being operated on:')
            call lvl_ud(1)
            call writo('This translates to a scale factor 1/'//&
                &trim(r2strt(mem_scale_fac)))
            call writo('Therefore, the memory left for the perturbation phase &
                &is '//trim(i2str(ceiling(max_x_mem)))//'MB')
            call lvl_ud(-1)
        end if
        
        ! user output
        call lvl_ud(-1)
        call writo('Equilibrium jobs divided')
    end function divide_eq_jobs
    
    integer function calc_eq_jobs_lims(n_par_X,n_div) result(ierr)
        use num_vars, only: prog_style, eq_jobs_lims, eq_job_nr
        use rich_vars, only: rich_lvl
        
        character(*), parameter :: rout_name = 'calc_eq_jobs_lims'
        
        ! input / output
        integer, intent(in) :: n_par_x
        integer, intent(in) :: n_div
        
        ! local variables
        integer :: id                                                           ! counter
        integer :: ol_width                                                     ! overlap width
        integer, allocatable :: n_par(:)                                        ! number of points per range
        character(len=max_str_ln) :: err_msg                                    ! error message
        
        ! initialize ierr
        ierr = 0
        
        ! Also initialize eq_job_nr to 0 as it is incremented by "do_eq".
        eq_job_nr = 0
        
        allocate(n_par(n_div))
        n_par = n_par_x/n_div                                                   ! number of parallel points on this processor
        n_par(1:mod(n_par_x,n_div)) = n_par(1:mod(n_par_x,n_div)) + 1           ! add a point to if there is a remainder
        chckerr('')
        
        ! (re)allocate equilibrium jobs limits
        if (allocated(eq_jobs_lims)) deallocate(eq_jobs_lims)
        allocate(eq_jobs_lims(2,n_div))
        
        ! set overlap width
        select case (prog_style)
            case (1)                                                            ! PB3D
                if (rich_lvl.eq.1) then
                    ol_width = 1
                else
                    ol_width = 0
                end if
            case (2)                                                            ! POST
                ol_width = 1
        end select
        
        ! loop over divisions
        do id = 1,n_div
            ! setup  first  guess,  without   taking  into  account  fundamental
            ! integration intervals
            if (id.eq.1) then
                eq_jobs_lims(1,id) = 1
            else
                eq_jobs_lims(1,id) = eq_jobs_lims(2,id-1) + 1 - ol_width
            end if
            eq_jobs_lims(2,id) = sum(n_par(1:id))
            
            ! take into account fundamental interval
            if (n_div.gt.1) then
                eq_jobs_lims(2,id) = eq_jobs_lims(1,id) - 1 + ol_width + &
                    &fund_n_par * max(1,nint(&
                    &(eq_jobs_lims(2,id)-eq_jobs_lims(1,id)+1._dp-ol_width)/&
                    &fund_n_par))
            end if
        end do
        
        ! test whether end coincides with sum of n_par
        if (eq_jobs_lims(2,n_div).ne.sum(n_par)) then
            ierr = 1
            err_msg = 'Limits don''t match, try with more memory or lower &
                &magn_int_style'
            chckerr(err_msg)
        end if
    end function calc_eq_jobs_lims
    
#if ldebug
 
    integer function test_t_ef(grid_eq,eq_1,eq_2) result(ierr)
        use num_vars, only: use_pol_flux_f, eq_style
        use grid_utilities, only: trim_grid
        use num_utilities, only: c
        use output_ops, only: plot_diff_hdf5
        
        character(*), parameter :: rout_name = 'test_T_EF'
        
        ! input / output
        type(grid_type), intent(in) :: grid_eq
        type(eq_1_type), intent(in) :: eq_1
        type(eq_2_type), intent(in) :: eq_2
        
        ! local variables
        integer :: id, kd                                                       ! counter
        integer :: norm_id(2)                                                   ! untrimmed normal indices for trimmed grids
        real(dp), allocatable :: res(:,:,:,:)                                   ! calculated result
        character(len=max_str_ln) :: file_name                                  ! name of plot file
        character(len=max_str_ln) :: description                                ! description of plot
        integer :: tot_dim(3), loc_offset(3)                                    ! total dimensions and local offset
        type(grid_type) :: grid_trim                                            ! trimmed equilibrium grid
        
        ! initialize ierr
        ierr = 0
        
        ! output
        call writo('Going to test whether T_EF complies with the theory')
        call lvl_ud(1)
        
        ! trim extended grid into plot grid
        ierr = trim_grid(grid_eq,grid_trim,norm_id)
        chckerr('')
        
        ! set total and local dimensions and local offset
        tot_dim = [grid_trim%n(1),grid_trim%n(2),grid_trim%n(3)]
        loc_offset = [0,0,grid_trim%i_min-1]
        
        ! set up res
        allocate(res(grid_trim%n(1),grid_trim%n(2),grid_trim%loc_n_r,9))
        res = 0.0_dp
        
        ! calc  res,  depending  on flux  used  in F  coordinates  and on  which
        ! equilibrium style is being used:
        !   1:  VMEC
        !   2:  HELENA
        select case (eq_style)
            case (1)                                                            ! VMEC
                if (use_pol_flux_f) then                                        ! using poloidal flux
                    ! calculate T_EF(1,1)
                    do kd = norm_id(1),norm_id(2)
                        res(:,:,kd-norm_id(1)+1,1) = &
                            &grid_eq%theta_F(:,:,kd)*eq_1%q_saf_E(kd,1) + &
                            &eq_2%L_E(:,:,kd,1,0,0)*eq_1%q_saf_E(kd,0)
                    end do
                    ! calculate T_EF(2,1)
                    do kd = norm_id(1),norm_id(2)
                        res(:,:,kd-norm_id(1)+1,2) = &
                            &(1._dp + eq_2%L_E(:,:,kd,0,1,0))*eq_1%q_saf_E(kd,0)
                    end do
                    ! calculate T_EF(3,1)
                    do kd = norm_id(1),norm_id(2)
                        res(:,:,kd-norm_id(1)+1,3) = -1._dp + &
                            &eq_2%L_E(:,:,kd,0,0,1)*eq_1%q_saf_E(kd,0)
                    end do
                    ! calculate T_EF(1,2)
                    do kd = norm_id(1),norm_id(2)
                        res(:,:,kd-norm_id(1)+1,4) = eq_1%flux_p_E(kd,1)/(2*pi)
                    end do
                    ! calculate T_EF(1,3)
                    res(:,:,:,7) = eq_2%L_E(:,:,norm_id(1):norm_id(2),1,0,0)
                    ! calculate T_EF(2,3)
                    res(:,:,:,8) = 1._dp + &
                        &eq_2%L_E(:,:,norm_id(1):norm_id(2),0,1,0)
                    ! calculate T_EF(3,3)
                    res(:,:,:,9) = eq_2%L_E(:,:,norm_id(1):norm_id(2),0,0,1)
                else                                                            ! using toroidal flux
                    ! calculate T_EF(1,1)
                    do kd = norm_id(1),norm_id(2)
                        res(:,:,kd-norm_id(1)+1,1) = - eq_2%L_E(:,:,kd,1,0,0) &
                            &+ grid_eq%zeta_E(:,:,kd)*eq_1%rot_t_E(kd,1)
                    end do
                    ! calculate T_EF(2,1)
                    res(:,:,:,2) = &
                        &- (1._dp + eq_2%L_E(:,:,norm_id(1):norm_id(2),0,1,0))
                    ! calculate T_EF(3,1)
                    do kd = norm_id(1),norm_id(2)
                        res(:,:,kd-norm_id(1)+1,3) = &
                            &eq_1%rot_t_E(kd,0) - eq_2%L_E(:,:,kd,0,0,1)
                    end do
                    ! calculate T_EF(1,2)
                    do kd = norm_id(1),norm_id(2)
                        res(:,:,kd-norm_id(1)+1,4) = &
                            &- eq_1%flux_t_E(kd,1)/(2*pi)
                    end do
                    ! calculate T_EF(3,3)
                    res(:,:,:,9) = -1._dp
                end if
            case (2)                                                            ! HELENA
                if (use_pol_flux_f) then                                        ! using poloidal flux
                    ! calculate T_EF(1,1)
                    do kd = norm_id(1),norm_id(2)
                        res(:,:,kd-norm_id(1)+1,1) = &
                            &- eq_1%q_saf_E(kd,1)*grid_eq%theta_E(:,:,kd)
                    end do
                    ! calculate T_EF(2,1)
                    do kd = norm_id(1),norm_id(2)
                        res(:,:,kd-norm_id(1)+1,2) = - eq_1%q_saf_E(kd,0)
                    end do
                    ! calculate T_EF(3,1)
                    res(:,:,:,3) = 1._dp
                    ! calculate T_EF(1,2)
                    do kd = norm_id(1),norm_id(2)
                        res(:,:,kd-norm_id(1)+1,4) = eq_1%flux_p_E(kd,1)/(2*pi)
                    end do
                    ! calculate T_EF(2,3)
                    res(:,:,:,8) = 1._dp
                else                                                            ! using toroidal flux
                    ! calculate T_EF(1,1)
                    do kd = norm_id(1),norm_id(2)
                        res(:,:,kd-norm_id(1)+1,1) = &
                            &eq_1%rot_t_E(kd,1)*grid_eq%zeta_E(:,:,kd)
                    end do
                    ! calculate T_EF(2,1)
                    res(:,:,:,2) = -1._dp
                    ! calculate T_EF(3,1)
                    do kd = norm_id(1),norm_id(2)
                        res(:,:,kd-norm_id(1)+1,3) = eq_1%rot_t_E(kd,0)
                    end do
                    ! calculate T_EF(1,2)
                    do kd = norm_id(1),norm_id(2)
                        res(:,:,kd-norm_id(1)+1,4) = eq_1%flux_t_E(kd,1)/(2*pi)
                    end do
                    ! calculate T_EF(3,3)
                    res(:,:,:,9) = 1._dp
                end if
        end select
        
        ! set up plot variables for calculated values
        do id = 1,3
            do kd = 1,3
                ! user output
                call writo('Testing T_EF('//trim(i2str(kd))//','//&
                    &trim(i2str(id))//')')
                call lvl_ud(1)
                
                ! set some variables
                file_name = 'TEST_T_EF_'//trim(i2str(kd))//'_'//trim(i2str(id))
                description = 'Testing calculated with given value for T_EF('//&
                    &trim(i2str(kd))//','//trim(i2str(id))//')'
                
                ! plot difference
                call plot_diff_hdf5(res(:,:,:,c([kd,id],.false.)),&
                    &eq_2%T_EF(:,:,norm_id(1):norm_id(2),c([kd,id],.false.),&
                    &0,0,0),file_name,tot_dim,loc_offset,description,&
                    &output_message=.true.)
                
                call lvl_ud(-1)
            end do
        end do
        
        ! clean up
        call grid_trim%dealloc()
        
        ! user output
        call lvl_ud(-1)
        call writo('Test complete')
    end function test_t_ef
    
    integer function test_d12h_h(grid_eq,eq) result(ierr)
        use grid_utilities, only: trim_grid
        use num_utilities, only: c, spline
        use num_vars, only: norm_disc_prec_eq
        use helena_vars, only: ias
        
        character(*), parameter :: rout_name = 'test_D12h_H'
        
        ! input / output
        type(grid_type), intent(in) :: grid_eq
        type(eq_2_type), intent(in) :: eq
        
        ! local variables
        integer :: norm_id(2)                                                   ! untrimmed normal indices for trimmed grids
        integer :: id, jd, kd, ld                                               ! counters
        integer :: bcs(2,2)                                                     ! boundary conditions (theta(even), theta(odd))
        integer :: bc_ld(6)                                                     ! boundary condition type for each metric element
        real(dp) :: bcs_val(2,3)                                                ! values for boundary conditions
        real(dp), allocatable :: res(:,:,:,:)                                   ! result variable
        character(len=max_str_ln) :: file_name                                  ! name of plot file
        character(len=max_str_ln) :: description                                ! description of plot
        integer :: tot_dim(3), loc_offset(3)                                    ! total dimensions and local offset
        type(grid_type) :: grid_trim                                            ! trimmed equilibrium grid
        
        ! initialize ierr
        ierr = 0
        
        ! output
        call writo('Going to test whether D1 D2 h_H is calculated correctly')
        call lvl_ud(1)
        
        ! trim extended grid into plot grid
        ierr = trim_grid(grid_eq,grid_trim,norm_id)
        chckerr('')
        
        ! set up res
        allocate(res(grid_trim%n(1),grid_trim%n(2),grid_trim%loc_n_r,6))
        
        ! set total and local dimensions and local offset
        tot_dim = [grid_trim%n(1),grid_trim%n(2),grid_trim%n(3)]
        loc_offset = [0,0,grid_trim%i_min-1]
        
        ! set up boundary conditions
        if (ias.eq.0) then                                                      ! top-bottom symmetric
            bcs(:,1) = [1,1]                                                    ! theta(even): zero first derivative
            bcs(:,2) = [2,2]                                                    ! theta(odd): zero first derivative
        else
            bcs(:,1) = [-1,-1]                                                  ! theta(even): periodic
            bcs(:,2) = [-1,-1]                                                  ! theta(odd): periodic
        end if
        bcs_val = 0._dp
        
        ! boundary condition type for each metric element
        bc_ld = [1,2,0,1,0,1]                                                   ! 1: even, 2: odd, 0: zero
        
        ! calculate D1 D2 h_H alternatively
        do ld = 1,6
            do kd = norm_id(1),norm_id(2)
                do jd = 1,grid_trim%n(2)
                    if (bc_ld(ld).eq.0) cycle                                   ! quantity is zero
                    
                    ierr = spline(grid_eq%theta_E(:,jd,kd),&
                        &eq%h_E(:,jd,kd,ld,0,1,0),grid_eq%theta_E(:,jd,kd),&
                        &res(:,jd,kd-norm_id(1)+1,ld),ord=norm_disc_prec_eq,&
                        &deriv=1,bcs=bcs(:,bc_ld(ld)),&
                        &bcs_val=bcs_val(:,bc_ld(ld)))
                    chckerr('')
                end do
            end do
        end do
        
        ! set up plot variables for calculated values
        do id = 1,3
            do kd = 1,3
                ! user output
                call writo('Testing h_H('//trim(i2str(kd))//','//&
                    &trim(i2str(id))//')')
                call lvl_ud(1)
                
                ! set some variables
                file_name = 'TEST_D12h_H_'//trim(i2str(kd))//'_'//&
                    &trim(i2str(id))
                description = 'Testing calculated with given value for D12h_H('&
                    &//trim(i2str(kd))//','//trim(i2str(id))//')'
                
                ! plot difference
                call plot_diff_hdf5(res(:,:,:,c([kd,id],.true.)),&
                    &eq%h_E(:,:,norm_id(1):norm_id(2),&
                    &c([kd,id],.true.),1,1,0),file_name,tot_dim,loc_offset,&
                    &description,output_message=.true.)
                
                call lvl_ud(-1)
            end do
        end do
        
        ! clean up
        call grid_trim%dealloc()
        
        ! user output
        call lvl_ud(-1)
        call writo('Test complete')
    end function test_d12h_h
    
    integer function test_jac_f(grid_eq,eq_1,eq_2) result(ierr)
        use num_vars, only: eq_style, use_pol_flux_f
        use grid_utilities, only: trim_grid
        use num_utilities, only: calc_det
        use helena_vars, only: h_h_33, rbphi_h
        
        character(*), parameter :: rout_name = 'test_jac_F'
        
        ! input / output
        type(grid_type), intent(in) :: grid_eq
        type(eq_1_type), intent(in), target :: eq_1
        type(eq_2_type), intent(in) :: eq_2
        
        ! local variables
        integer :: norm_id(2)                                                   ! untrimmed normal indices for trimmed grids
        real(dp), allocatable :: res(:,:,:)                                     ! result variable
        integer :: jd, kd                                                       ! counters
        character(len=max_str_ln) :: file_name                                  ! name of plot file
        character(len=max_str_ln) :: description                                ! description of plot
        integer :: tot_dim(3), loc_offset(3)                                    ! total dimensions and local offset
        type(grid_type) :: grid_trim                                            ! trimmed equilibrium grid
        real(dp), pointer :: dflux(:) => null()                                 ! points to D flux_p or D flux_t in E coordinates
        integer :: pmone                                                        ! plus or minus one
        
        ! initialize ierr
        ierr = 0
        
        ! output
        call writo('Going to test the calculation of the Jacobian in Flux &
            &coordinates')
        call lvl_ud(1)
        
        ! trim extended grid into plot grid
        ierr = trim_grid(grid_eq,grid_trim,norm_id)
        chckerr('')
        
        ! set up res
        allocate(res(grid_trim%n(1),grid_trim%n(2),grid_trim%loc_n_r))
        
        ! set total and local dimensions and local offset
        tot_dim = [grid_trim%n(1),grid_trim%n(2),grid_trim%n(3)]
        loc_offset = [0,0,grid_trim%i_min-1]
        
        ! 1. Compare with determinant of g_F
        
        ! calculate Jacobian from determinant of g_F
        ierr = calc_det(res,eq_2%g_F(:,:,norm_id(1):norm_id(2),:,0,0,0),3)
        chckerr('')
        
        ! set some variables
        file_name = 'TEST_jac_F_1'
        description = 'Testing whether the Jacobian in Flux coordinates is &
            &consistent with determinant of metric matrix'
        
        ! plot difference
        call plot_diff_hdf5(res(:,:,:),&
            &eq_2%jac_F(:,:,norm_id(1):norm_id(2),0,0,0)**2,&
            &file_name,tot_dim,loc_offset,description,output_message=.true.)
        
        ! 2. Compare with explicit formula
        
        ! set up Dflux and pmone
        if (use_pol_flux_f) then                                                ! using poloidal flux
            dflux => eq_1%flux_p_E(:,1)
            pmone = 1                                                           ! flux_p_V = flux_p_F
        else
            dflux => eq_1%flux_t_E(:,1)
            pmone = -1                                                          ! flux_t_V = - flux_t_F
        end if
        
        ! calculate jac_F
        ! choose which equilibrium style is being used:
        !   1:  VMEC
        !   2:  HELENA
        select case (eq_style)
            case (1)                                                            ! VMEC
                do kd = norm_id(1),norm_id(2)
                    res(:,:,kd-norm_id(1)+1) = pmone * 2*pi * &
                        &eq_2%R_E(:,:,kd,0,0,0)*&
                        &(eq_2%R_E(:,:,kd,1,0,0)*eq_2%Z_E(:,:,kd,0,1,0) - &
                        &eq_2%Z_E(:,:,kd,1,0,0)*eq_2%R_E(:,:,kd,0,1,0)) / &
                        &(dflux(kd)*(1+eq_2%L_E(:,:,kd,0,1,0)))
                end do
            case (2)                                                            ! HELENA
                do kd = norm_id(1),norm_id(2)
                    do jd = 1,grid_trim%n(2)
                        res(:,jd,kd-norm_id(1)+1) = eq_1%q_saf_E(kd,0)/&
                            &(h_h_33(:,kd+grid_eq%i_min-1)*&
                            &rbphi_h(kd+grid_eq%i_min-1,0))                     ! h_H_33 = 1/R^2 and RBphi_H = F are tabulated in eq. grid
                    end do
                end do
        end select
        
        ! set some variables
        file_name = 'TEST_jac_F_2'
        description = 'Testing whether the Jacobian in Flux coordinates is &
            &consistent with explicit formula'
        
        ! plot difference
        call plot_diff_hdf5(res(:,:,:),&
            &eq_2%jac_F(:,:,norm_id(1):norm_id(2),0,0,0),file_name,tot_dim,&
            &loc_offset,description,output_message=.true.)
        
        ! clean up
        nullify(dflux)
        call grid_trim%dealloc()
        
        ! user output
        call lvl_ud(-1)
        call writo('Test complete')
    end function test_jac_f
    
    integer function test_g_v(grid_eq,eq) result(ierr)
        use grid_utilities, only: trim_grid
        use num_utilities, only: c
        
        character(*), parameter :: rout_name = 'test_g_V'
        
        ! input / output
        type(grid_type), intent(in) :: grid_eq
        type(eq_2_type), intent(in) :: eq
        
        ! local variables
        integer :: norm_id(2)                                                   ! untrimmed normal indices for trimmed grids
        integer :: id, kd                                                       ! counters
        real(dp), allocatable :: res(:,:,:,:)                                   ! result variable
        character(len=max_str_ln) :: file_name                                  ! name of plot file
        character(len=max_str_ln) :: description                                ! description of plot
        integer :: tot_dim(3), loc_offset(3)                                    ! total dimensions and local offset
        type(grid_type) :: grid_trim                                            ! trimmed equilibrium grid
        
        ! initialize ierr
        ierr = 0
        
        ! output
        call writo('Going to test whether g_V is calculated correctly')
        call lvl_ud(1)
        
        ! trim extended grid into plot grid
        ierr = trim_grid(grid_eq,grid_trim,norm_id)
        chckerr('')
        
        ! set up res
        allocate(res(grid_trim%n(1),grid_trim%n(2),grid_trim%loc_n_r,6))
        
        ! set total and local dimensions and local offset
        tot_dim = [grid_trim%n(1),grid_trim%n(2),grid_trim%n(3)]
        loc_offset = [0,0,grid_trim%i_min-1]
        
        ! calculate g_V(1,1)
        res(:,:,:,1) = eq%R_E(:,:,norm_id(1):norm_id(2),1,0,0)**2 + &
            &eq%Z_E(:,:,norm_id(1):norm_id(2),1,0,0)**2
        ! calculate g_V(2,1)
        res(:,:,:,2) = eq%R_E(:,:,norm_id(1):norm_id(2),1,0,0)*&
            &eq%R_E(:,:,norm_id(1):norm_id(2),0,1,0) + &
            &eq%Z_E(:,:,norm_id(1):norm_id(2),1,0,0)*&
            &eq%Z_E(:,:,norm_id(1):norm_id(2),0,1,0)
        ! calculate g_V(3,1)
        res(:,:,:,3) = eq%R_E(:,:,norm_id(1):norm_id(2),1,0,0)*&
            &eq%R_E(:,:,norm_id(1):norm_id(2),0,0,1) + &
            &eq%Z_E(:,:,norm_id(1):norm_id(2),1,0,0)*&
            &eq%Z_E(:,:,norm_id(1):norm_id(2),0,0,1)
        ! calculate g_V(2,2)
        res(:,:,:,4) = eq%R_E(:,:,norm_id(1):norm_id(2),0,1,0)**2 + &
            &eq%Z_E(:,:,norm_id(1):norm_id(2),0,1,0)**2
        ! calculate g_V(3,2)
        res(:,:,:,5) = eq%R_E(:,:,norm_id(1):norm_id(2),0,1,0)*&
            &eq%R_E(:,:,norm_id(1):norm_id(2),0,0,1) + &
            &eq%Z_E(:,:,norm_id(1):norm_id(2),0,1,0)*&
            &eq%Z_E(:,:,norm_id(1):norm_id(2),0,0,1)
        ! calculate g_V(3,3)
        res(:,:,:,6) = eq%R_E(:,:,norm_id(1):norm_id(2),0,0,1)**2 + &
            &eq%Z_E(:,:,norm_id(1):norm_id(2),0,0,1)**2 + &
            &eq%R_E(:,:,norm_id(1):norm_id(2),0,0,0)**2
        
        ! set up plot variables for calculated values
        do id = 1,3
            do kd = 1,3
                ! user output
                call writo('Testing g_V('//trim(i2str(kd))//','//&
                    &trim(i2str(id))//')')
                call lvl_ud(1)
                
                ! set some variables
                file_name = 'TEST_g_V_'//trim(i2str(kd))//'_'//trim(i2str(id))
                description = 'Testing calculated with given value for g_V('//&
                    &trim(i2str(kd))//','//trim(i2str(id))//')'
                
                ! plot difference
                call plot_diff_hdf5(res(:,:,:,c([kd,id],.true.)),&
                    &eq%g_E(:,:,norm_id(1):norm_id(2),c([kd,id],.true.),&
                    &0,0,0),file_name,tot_dim,loc_offset,description,&
                    &output_message=.true.)
                
                call lvl_ud(-1)
            end do
        end do
        
        ! clean up
        call grid_trim%dealloc()
        
        ! user output
        call lvl_ud(-1)
        call writo('Test complete')
    end function test_g_v
    
    integer function test_jac_v(grid_eq,eq) result(ierr)
        use grid_utilities, only: trim_grid
        use num_utilities, only: calc_det
        
        character(*), parameter :: rout_name = 'test_jac_V'
        
        ! input / output
        type(grid_type), intent(in) :: grid_eq
        type(eq_2_type), intent(in) :: eq
        
        ! local variables
        integer :: norm_id(2)                                                   ! untrimmed normal indices for trimmed grids
        real(dp), allocatable :: res(:,:,:)                                     ! result variable
        character(len=max_str_ln) :: file_name                                  ! name of plot file
        character(len=max_str_ln) :: description                                ! description of plot
        integer :: tot_dim(3), loc_offset(3)                                    ! total dimensions and local offset
        type(grid_type) :: grid_trim                                            ! trimmed equilibrium grid
        
        ! initialize ierr
        ierr = 0
        
        ! output
        call writo('Going to test the calculation of the Jacobian in the VMEC &
            &coords.')
        call lvl_ud(1)
        
        ! trim extended grid into plot grid
        ierr = trim_grid(grid_eq,grid_trim,norm_id)
        chckerr('')
        
        ! set up res
        allocate(res(grid_trim%n(1),grid_trim%n(2),grid_trim%loc_n_r))
        
        ! set total and local dimensions and local offset
        tot_dim = [grid_trim%n(1),grid_trim%n(2),grid_trim%n(3)]
        loc_offset = [0,0,grid_trim%i_min-1]
        
        ! calculate Jacobian from determinant of g_V
        ierr = calc_det(res,eq%g_E(:,:,norm_id(1):norm_id(2),:,0,0,0),3)
        chckerr('')
        
        ! set some variables
        file_name = 'TEST_jac_V'
        description = 'Testing whether the Jacobian in VMEC coordinates is &
            &consistent with determinant of metric matrix'
        
        ! plot difference
        call plot_diff_hdf5(-sqrt(res),&
            &eq%jac_E(:,:,norm_id(1):norm_id(2),0,0,0),&
            &file_name,tot_dim,loc_offset,description,output_message=.true.)
        
        ! clean up
        call grid_trim%dealloc()
        
        ! user output
        call lvl_ud(-1)
        call writo('Test complete')
    end function test_jac_v
    
    integer function test_b_f(grid_eq,eq_1,eq_2) result(ierr)
        use num_vars, only: eq_style
        use grid_utilities, only: trim_grid
        use num_utilities, only: c
        use vmec_utilities, only: fourier2real
        use vmec_vars, only: b_v_sub_s, b_v_sub_c, b_v_c, b_v_s, is_asym_v
        
        character(*), parameter :: rout_name = 'test_B_F'
        
        ! input / output
        type(grid_type), intent(in) :: grid_eq
        type(eq_1_type), intent(in) :: eq_1
        type(eq_2_type), intent(in) :: eq_2
        
        ! local variables
        integer :: norm_id(2)                                                   ! untrimmed normal indices for trimmed grids
        integer :: norm_id_f(2)                                                 ! norm_id transposed to full grid
        integer :: id, kd                                                       ! counters
        real(dp), allocatable :: res(:,:,:,:)                                   ! result variable
        real(dp), allocatable :: res2(:,:,:,:)                                  ! result variable
        character(len=max_str_ln) :: file_name                                  ! name of plot file
        character(len=max_str_ln) :: description                                ! description of plot
        integer :: tot_dim(3), loc_offset(3)                                    ! total dimensions and local offset
        type(grid_type) :: grid_trim                                            ! trimmed equilibrium grid
        
        ! initialize ierr
        ierr = 0
        
        ! output
        call writo('Going to test whether the magnetic field is calculated &
            &correctly')
        call lvl_ud(1)
        
        ! trim extended grid into plot grid
        ierr = trim_grid(grid_eq,grid_trim,norm_id)
        chckerr('')
        
        ! set norm_id_f for quantities tabulated on full grid
        norm_id_f = grid_eq%i_min+norm_id-1
        
        ! set up res and res2
        allocate(res(grid_trim%n(1),grid_trim%n(2),grid_trim%loc_n_r,4))
        allocate(res2(grid_trim%n(1),grid_trim%n(2),grid_trim%loc_n_r,4))
        
        ! set total and local dimensions and local offset
        tot_dim = [grid_trim%n(1),grid_trim%n(2),grid_trim%n(3)]
        loc_offset = [0,0,grid_trim%i_min-1]
        
        ! get covariant components and magnitude of B_E
        ! choose which equilibrium style is being used:
        !   1:  VMEC
        !   2:  HELENA
        select case (eq_style)
            case (1)                                                            ! VMEC
                do id = 1,3
                    ierr = fourier2real(&
                        &b_v_sub_c(:,norm_id_f(1):norm_id_f(2),id),&
                        &b_v_sub_s(:,norm_id_f(1):norm_id_f(2),id),&
                        &grid_eq%trigon_factors(:,:,:,norm_id(1):&
                        &norm_id(2),:),res(:,:,:,id))
                    chckerr('')
                end do
                ierr = fourier2real(b_v_c(:,norm_id_f(1):norm_id_f(2)),&
                    &b_v_s(:,norm_id_f(1):norm_id_f(2)),&
                    &grid_eq%trigon_factors(:,:,:,norm_id(1):norm_id(2),:),&
                    &res(:,:,:,4),[.true.,is_asym_v])
                chckerr('')
            case (2)                                                            ! HELENA
                res(:,:,:,1) = &
                    &eq_2%g_E(:,:,norm_id(1):norm_id(2),c([1,2],.true.),0,0,0)
                res(:,:,:,2) = &
                    &eq_2%g_E(:,:,norm_id(1):norm_id(2),c([2,2],.true.),0,0,0)
                do kd = norm_id(1),norm_id(2)
                    res(:,:,kd-norm_id(1)+1,3) = eq_1%q_saf_E(kd,0)*&
                        &eq_2%g_E(:,:,kd,c([3,3],.true.),0,0,0)
                    res(:,:,kd-norm_id(1)+1,4) = &
                        &sqrt(eq_2%g_E(:,:,kd,c([2,2],.true.),0,0,0) + &
                        &eq_1%q_saf_E(kd,0)**2*&
                        &eq_2%g_E(:,:,kd,c([3,3],.true.),0,0,0))
                end do
                do id = 1,4
                    do kd = norm_id(1),norm_id(2)
                        res(:,:,kd-norm_id(1)+1,id) = &
                            &res(:,:,kd-norm_id(1)+1,id)/&
                            &eq_2%jac_E(:,:,kd,0,0,0)
                    end do
                end do
        end select
        
        ! transform them to Flux coord. system
        res2 = 0._dp
        do id = 1,3
            do kd = 1,3
                res2(:,:,:,id) = res2(:,:,:,id) + &
                    &res(:,:,:,kd) * eq_2%T_FE(:,:,norm_id(1):&
                    &norm_id(2),c([id,kd],.false.),0,0,0)
            end do
        end do
        res2(:,:,:,4) = res(:,:,:,4)
        
        ! set up plot variables for calculated values
        do id = 1,4
            ! user output
            if (id.lt.4) then
                call writo('Testing B_F_'//trim(i2str(id)))
            else
                call writo('Testing B_F')
            end if
            call lvl_ud(1)
            
            ! set some variables
            if (id.lt.4) then
                file_name = 'TEST_B_F_'//trim(i2str(id))
                description = 'Testing calculated with given value for B_F_'//&
                    &trim(i2str(id))
            else
                file_name = 'TEST_B_F'
                description = 'Testing calculated with given value for B_F'
            end if
            
            ! plot difference
            if (id.lt.4) then
                call plot_diff_hdf5(res2(:,:,:,id),&
                    &eq_2%g_F(:,:,norm_id(1):norm_id(2),c([3,id],.true.),0,0,0)&
                    &/eq_2%jac_F(:,:,norm_id(1):norm_id(2),0,0,0),file_name,&
                    &tot_dim,loc_offset,description,output_message=.true.)
            else
                call plot_diff_hdf5(res2(:,:,:,id),sqrt(&
                    &eq_2%g_F(:,:,norm_id(1):norm_id(2),c([3,3],.true.),0,0,0))&
                    &/eq_2%jac_F(:,:,norm_id(1):norm_id(2),0,0,0),file_name,&
                    &tot_dim,loc_offset,description,output_message=.true.)
            end if
            
            call lvl_ud(-1)
        end do
        
        ! clean up
        call grid_trim%dealloc()
        
        ! user output
        call lvl_ud(-1)
        call writo('Test complete')
    end function test_b_f
    
    integer function test_p(grid_eq,eq_1,eq_2) result(ierr)
        use num_utilities, only: c, spline
        use grid_utilities, only: trim_grid
        use eq_vars, only: vac_perm
        use num_vars, only: eq_style, norm_disc_prec_eq
        use helena_vars, only: rbphi_h, h_h_11, h_h_12
        
        character(*), parameter :: rout_name = 'test_p'
        
        ! input / output
        type(grid_type), intent(in) :: grid_eq
        type(eq_1_type), intent(in) :: eq_1
        type(eq_2_type), intent(in) :: eq_2
        
        ! local variables
        integer :: norm_id(2)                                                   ! untrimmed normal indices for trimmed grids
        integer :: norm_id_f(2)                                                 ! norm_id transposed to full grid
        real(dp), allocatable :: res(:,:,:,:)                                   ! result variable
        integer :: id, jd, kd                                                   ! counters
        character(len=max_str_ln) :: file_name                                  ! name of plot file
        character(len=max_str_ln) :: description                                ! description of plot
        integer :: tot_dim(3), loc_offset(3)                                    ! total dimensions and local offset
        type(grid_type) :: grid_trim                                            ! trimmed equilibrium grid
        
        ! initialize ierr
        ierr = 0
        
        ! output
        call writo('Going to test the consistency of the equilibrium variables &
            &with the given pressure')
        call lvl_ud(1)
        
        ! trim extended grid into plot grid
        ierr = trim_grid(grid_eq,grid_trim,norm_id)
        chckerr('')
        
        ! set up res
        allocate(res(grid_trim%n(1),grid_trim%n(2),grid_trim%loc_n_r,2))
        
        ! user output
        call writo('Checking if mu_0 D2 p = 1/J (D3 B_2 - D2_B3)')
        call lvl_ud(1)
        
        ! set total and local dimensions and local offset
        tot_dim = [grid_trim%n(1),grid_trim%n(2),grid_trim%n(3)]
        loc_offset = [0,0,grid_trim%i_min-1]
        
        ! calculate mu_0 D2p
        res(:,:,:,1) = &
            &(eq_2%g_FD(:,:,norm_id(1):norm_id(2),c([2,3],.true.),0,0,1) - &
            &eq_2%g_FD(:,:,norm_id(1):norm_id(2),c([3,3],.true.),0,1,0))/&
            &eq_2%jac_FD(:,:,norm_id(1):norm_id(2),0,0,0) - &
            &(eq_2%g_FD(:,:,norm_id(1):norm_id(2),c([2,3],.true.),0,0,0)*&
            &eq_2%jac_FD(:,:,norm_id(1):norm_id(2),0,0,1) - &
            &eq_2%g_FD(:,:,norm_id(1):norm_id(2),c([3,3],.true.),0,0,0)*&
            &eq_2%jac_FD(:,:,norm_id(1):norm_id(2),0,1,0))/ &
            &(eq_2%jac_FD(:,:,norm_id(1):norm_id(2),0,0,0)**2)
        res(:,:,:,1) = res(:,:,:,1)/eq_2%jac_FD(:,:,norm_id(1):norm_id(2),0,0,0)
        !!call plot_HDF5('var','TEST_Dg_FD_23',eq_2%g_FD(:,:,norm_id(1):norm_id(2),c([2,3],.true.),0,0,1))
        !!call plot_HDF5('var','TEST_g_FD_23',eq_2%g_FD(:,:,norm_id(1):norm_id(2),c([2,3],.true.),0,0,0))
        !!call plot_HDF5('var','TEST_Dg_FD_33',eq_2%g_FD(:,:,norm_id(1):norm_id(2),c([3,3],.true.),0,1,0))
        !!call plot_HDF5('var','TEST_g_FD_33',eq_2%g_FD(:,:,norm_id(1):norm_id(2),c([3,3],.true.),0,0,0))
        !!call plot_HDF5('var','TEST_Dg_FD',eq_2%jac_FD(:,:,norm_id(1):norm_id(2),0,0,1))
        !!call plot_HDF5('var','TEST_g_FD',eq_2%jac_FD(:,:,norm_id(1):norm_id(2),0,0,0))
        
        ! save mu_0 D2p in res
        do kd = norm_id(1),norm_id(2)
            res(:,:,kd-norm_id(1)+1,2) = vac_perm*eq_1%pres_FD(kd,1)
        end do
        
        ! set some variables
        file_name = 'TEST_D2p'
        description = 'Testing whether mu_0 D2 p = 1/J (D3 B_2 - D2_B3)'
        
        ! plot difference
        call plot_diff_hdf5(res(:,:,:,1),res(:,:,:,2),file_name,tot_dim,&
            &loc_offset,description,output_message=.true.)
        
        call lvl_ud(-1)
        
        ! user output
        call writo('Checking if mu_0 J D1p = 0 => D3 B_1 = D2 B_3')
        call lvl_ud(1)
        
        ! calculate D3 B1
        res(:,:,:,1) = &
            &eq_2%g_FD(:,:,norm_id(1):norm_id(2),c([1,3],.true.),0,0,1)/&
            &eq_2%jac_FD(:,:,norm_id(1):norm_id(2),0,0,0) - &
            &eq_2%g_FD(:,:,norm_id(1):norm_id(2),c([1,3],.true.),0,0,0)*&
            &eq_2%jac_FD(:,:,norm_id(1):norm_id(2),0,0,1) / &
            &eq_2%jac_FD(:,:,norm_id(1):norm_id(2),0,0,0)**2
        
        ! calculate D1 B3
        res(:,:,:,2) = &
            &eq_2%g_FD(:,:,norm_id(1):norm_id(2),c([3,3],.true.),1,0,0)/&
            &eq_2%jac_FD(:,:,norm_id(1):norm_id(2),0,0,0) - &
            &eq_2%g_FD(:,:,norm_id(1):norm_id(2),c([3,3],.true.),0,0,0)*&
            &eq_2%jac_FD(:,:,norm_id(1):norm_id(2),1,0,0) / &
            &eq_2%jac_FD(:,:,norm_id(1):norm_id(2),0,0,0)**2
        
        ! set some variables
        file_name = 'TEST_D1p'
        description = 'Testing whether D3 B_1 = D1 B_3'
        
        ! plot difference
        call plot_diff_hdf5(res(:,:,:,1),res(:,:,:,2),file_name,tot_dim,&
            &loc_offset,description,output_message=.true.)
        
        call lvl_ud(-1)
        
        ! extra testing if Helena
        if (eq_style.eq.2) then
            ! set norm_id_f for quantities tabulated on full grid
            norm_id_f = grid_eq%i_min+norm_id-1
            
            ! user output
            call writo('Checking if D2 B_3 |F = D1 (qF+qh_11/F) |H')
            call lvl_ud(1)
            
            ! calculate if D2 B_3 = D1 (qF) + D1 (q/F h_11)
            res(:,:,:,1) = &
                &(eq_2%g_FD(:,:,norm_id(1):norm_id(2),c([3,3],.true.),0,1,0)/&
                &eq_2%jac_FD(:,:,norm_id(1):norm_id(2),0,0,0) - &
                &eq_2%g_FD(:,:,norm_id(1):norm_id(2),c([3,3],.true.),0,0,0)*&
                &eq_2%jac_FD(:,:,norm_id(1):norm_id(2),0,1,0)/ &
                &(eq_2%jac_FD(:,:,norm_id(1):norm_id(2),0,0,0)**2))
            do jd = 1,grid_trim%n(2)
                do id = 1,grid_trim%n(1)
                    ierr = spline(grid_trim%loc_r_E,&
                        &eq_1%q_saf_E(norm_id(1):norm_id(2),0)*&
                        &rbphi_h(norm_id_f(1):norm_id_f(2),0)+&
                        &eq_1%q_saf_E(norm_id(1):norm_id(2),0)*&
                        &h_h_11(id,norm_id_f(1):norm_id_f(2))/&
                        &rbphi_h(norm_id_f(1):norm_id_f(2),0),&
                        &grid_trim%loc_r_E,res(id,jd,:,2),&
                        &ord=norm_disc_prec_eq,deriv=1)
                    chckerr('')
                end do
            end do
            
            ! set some variables
            file_name = 'TEST_D2B_3'
            description = 'Testing whether D2 B_3 |F = D1 (qF+qh_11/F) |H'
            
            ! plot difference
            call plot_diff_hdf5(res(:,:,:,1),res(:,:,:,2),file_name,tot_dim,&
                &loc_offset,description,output_message=.true.)
            
            call lvl_ud(-1)
            
            ! user output
            call writo('Checking if D3 B_2 |F = -q/F D2 h_11 + F q'' |H')
            call lvl_ud(1)
            
            ! calculate if D3 B_2 = -q/F D2 h_11 + F D1 q
            res(:,:,:,1) = &
                &eq_2%g_FD(:,:,norm_id(1):norm_id(2),c([2,3],.true.),0,0,1)/&
                &eq_2%jac_FD(:,:,norm_id(1):norm_id(2),0,0,0) - &
                &eq_2%g_FD(:,:,norm_id(1):norm_id(2),c([2,3],.true.),0,0,0)*&
                &eq_2%jac_FD(:,:,norm_id(1):norm_id(2),0,0,1)/ &
                &(eq_2%jac_FD(:,:,norm_id(1):norm_id(2),0,0,0)**2)
            do kd = norm_id(1),norm_id(2)
                do jd = 1,grid_trim%n(2)
                    ierr = spline(grid_eq%theta_E(:,jd,kd),&
                        &h_h_12(:,kd+grid_eq%i_min-1),grid_eq%theta_E(:,jd,kd),&
                        &res(:,jd,kd-norm_id(1)+1,2),&
                        &ord=norm_disc_prec_eq,deriv=1)
                    chckerr('')
                end do
                res(:,:,kd-norm_id(1)+1,2) = &
                    &-eq_1%q_saf_E(kd,0)/rbphi_h(kd+grid_eq%i_min-1,0) * &
                    &res(:,:,kd-norm_id(1)+1,2) + &
                    &rbphi_h(kd+grid_eq%i_min-1,0) * &
                    &eq_1%q_saf_E(kd,1)
            end do
            
            ! set some variables
            file_name = 'TEST_D3B_2'
            description = 'Testing whether D3 B_2 |F = -D2 (qh_12/F) + f q'' |H'
            
            ! plot difference
            call plot_diff_hdf5(res(:,:,:,1),res(:,:,:,2),file_name,tot_dim,&
                &loc_offset,description,output_message=.true.)
            
            call lvl_ud(-1)
        end if
        
        ! clean up
        call grid_trim%dealloc()
        
        ! user output
        call lvl_ud(-1)
        call writo('Test complete')
    end function test_p
#endif
end module eq_ops