kt_grids.f90 Source File


Contents

Source Code


Source Code

!> Set up the perpendicular wavenumbers by calling the appropriate sub-modules. 
module kt_grids
  use abstract_config, only: abstract_config_type, CONFIG_MAX_NAME_LEN
  use kt_grids_box, only: jtwist
  
  implicit none

  private

  public :: init_kt_grids, box, finish_kt_grids, check_kt_grids, wnml_kt
  public :: init_kt_grids_parameters, finish_kt_grids_parameters
  public :: set_overrides
  public :: aky, theta0, akx
  public :: naky, ntheta0, nx, ny, reality
  public :: ikx, jtwist_out
  public :: gridopt_switch, grid_option
  public :: gridopt_single, gridopt_range, gridopt_specified, gridopt_box
  public :: kwork_filter, kperp2, inv_kperp2

  public :: kt_grids_config_type
  public :: set_kt_grids_config
  public :: get_kt_grids_config

  logical, dimension(:,:), allocatable :: kwork_filter
  real, dimension (:,:,:), allocatable :: kperp2, inv_kperp2
  !> The \(\theta_0(k_x, k_y)\) grid
  real, dimension (:,:), allocatable :: theta0
  !> The \(k_x \rho\) grid
  real, dimension (:), allocatable :: akx
  !> The \(k_y \rho\) grid
  real, dimension (:), allocatable :: aky
  !> Discrete kx grid index
  integer, dimension(:), allocatable :: ikx
  !> Number of \(k_y \rho\) points
  integer :: naky
  !> Number of \(\theta_0\) points
  integer :: ntheta0
  !> Number of (real space) \(x\) points
  integer :: nx
  !> Number of (real space) \(y\) points
  integer :: ny
  !> Related to the box size in x. See
  !> [[kt_grids_box_parameters:jtwist]]
  integer :: jtwist_out
  !> The type of perpendicular wavenumber grid used. See
  !> [[kt_grids_knobs:grid_option]]
  character(20) :: grid_option

  ! internal variables
  integer :: gridopt_switch
  integer, parameter :: gridopt_single = 1, gridopt_range = 2, &
       gridopt_specified = 3, gridopt_box = 4
  logical :: reality = .false.
  logical :: box = .false.
  logical :: initialized = .false.
  logical :: kp2init=.false.
  logical :: parameters_read = .false.
  
  !> Used to represent the input configuration of kt_grids
  type, extends(abstract_config_type) :: kt_grids_config_type
     ! namelist : kt_grids_knobs
     ! indexed : false     
     !> Controls the type of perpendicular wavenumber grid to use.
     !> Can be one of
     !>
     !> - 'single' Evolve a single Fourier mode. Set up
     !> with [[kt_grids_single_parameters]].
     !> - 'default' Same as 'single'
     !> - 'range' Evolve a range of equally spaced Fourier
     !> modes. Set up with [[kt_grids_range_parameters]].
     !> - 'specified' Evolve an arbitrary set of Fourier modes. Set
     !> up with [[kt_grids_specified_parameters]] and corresponding
     !> [[kt_grids_specified_element]].
     !> - 'box' Simulation domain is logically rectangular. Set up with
     !> [[kt_grids_box_parameters]]. Required for nonlinear simulations.
     !> - 'nonlinear' Same as 'box.'
     !> - 'xbox' Experimental.
     !>
     character(len = 20) :: grid_option = "default"
   contains
     procedure, public :: read => read_kt_grids_config
     procedure, public :: write => write_kt_grids_config
     procedure, public :: reset => reset_kt_grids_config
     procedure, public :: broadcast => broadcast_kt_grids_config
     procedure, public, nopass :: get_default_name => get_default_name_kt_grids_config
     procedure, public, nopass :: get_default_requires_index => get_default_requires_index_kt_grids_config
  end type kt_grids_config_type
  
  type(kt_grids_config_type) :: kt_grids_config
  
contains

  !> FIXME : Add documentation
  subroutine init_kt_grids_parameters(kt_grids_config_in)
    use theta_grid, only: init_theta_grid
    use kt_grids_single, only: read_parameters_single
    use kt_grids_range, only: read_parameters_range
    use kt_grids_box, only: read_parameters_box
    implicit none
    type(kt_grids_config_type), intent(in), optional :: kt_grids_config_in
    
    if (parameters_read) return
    parameters_read = .true.
    
    call init_theta_grid
    call read_parameters_internal(kt_grids_config_in)

    ! Read all namelists in case grid_option is overriden
    ! kt_grids_specified parameters cannot be overriden at this time
    ! so kt_grids_specified parameters are read in get_sizes
    !
    ! @note Should pass in optional configs here
    call read_parameters_single
    call read_parameters_range
    call read_parameters_box

  end subroutine init_kt_grids_parameters

  !> FIXME : Add documentation  
  subroutine finish_kt_grids_parameters
    use kt_grids_single, only: finish_parameters_single
    use kt_grids_range, only: finish_parameters_range
    use kt_grids_specified, only: finish_parameters_specified
    use kt_grids_box, only: finish_parameters_box
    implicit none

    call finish_parameters_single
    call finish_parameters_specified    
    call finish_parameters_range
    call finish_parameters_box

    call kt_grids_config%reset()
    parameters_read = .false.
  end subroutine finish_kt_grids_parameters

  !> FIXME : Add documentation  
  subroutine set_overrides(grids_ov)
    use overrides, only: kt_grids_overrides_type
    use kt_grids_box, only: box_set_overrides
    use mp, only: mp_abort, proc0
    implicit none
    type(kt_grids_overrides_type), intent(in) :: grids_ov
    
    if (proc0) then
      select case (gridopt_switch)          
      case (gridopt_box)
        call box_set_overrides(grids_ov)
      case default
        call mp_abort("Overrides currently only implemented for kt_grids_box", .true.)
      end select
    end if
  end subroutine set_overrides

  !> FIXME : Add documentation
  !>
  !> @todo : Provide pass-through of other kt_grid module configs
  subroutine init_kt_grids(kt_grids_config_in)
    use mp, only: proc0, broadcast
    implicit none
    type(kt_grids_config_type), intent(in), optional :: kt_grids_config_in    

    if (initialized) return
    initialized = .true.

    call init_kt_grids_parameters(kt_grids_config_in)

    if (proc0) then
       call get_sizes
       jtwist_out = jtwist
    end if

    call broadcast (reality)
    call broadcast (box)
    call broadcast (naky)
    call broadcast (ntheta0)
    call broadcast (ny)
    call broadcast (nx)
    call broadcast (gridopt_switch)
    call allocate_arrays

    if (proc0) call get_grids
    call broadcast (ikx)     ! MR
    call broadcast (aky)
    call broadcast (akx)
    call broadcast (jtwist_out)
    call broadcast (theta0)
    allocate(kwork_filter(ntheta0,naky))
    kwork_filter=.false.
    call init_kperp2
  end subroutine init_kt_grids

  !> FIXME : Add documentation  
  subroutine read_parameters_internal(kt_grids_config_in)
    use file_utils, only: error_unit
    use text_options, only: text_option, get_option_value
    implicit none
    type(kt_grids_config_type), intent(in), optional :: kt_grids_config_in
    type (text_option), dimension (6), parameter :: gridopts = &
         (/ text_option('default', gridopt_single), &
            text_option('single', gridopt_single), &
            text_option('range', gridopt_range), &
            text_option('specified', gridopt_specified), &
            text_option('box', gridopt_box), &
            text_option('nonlinear', gridopt_box) /)
    integer :: ierr

    if (present(kt_grids_config_in)) kt_grids_config = kt_grids_config_in

    call kt_grids_config%init(name = 'kt_grids_knobs', requires_index = .false.)

    ! Copy out internal values into module level parameters
    associate(self => kt_grids_config)
#include "kt_grids_copy_out_auto_gen.inc"
    end associate
    
    ierr = error_unit()
    call get_option_value (grid_option, gridopts, gridopt_switch, &
         ierr, "grid_option in kt_grids_knobs",.true.)

  end subroutine read_parameters_internal

  !> FIXME : Add documentation  
  subroutine wnml_kt(unit)
    use kt_grids_single, only: wnml_kt_grids_single
    use kt_grids_range, only: wnml_kt_grids_range
    use kt_grids_specified, only: wnml_kt_grids_specified
    use kt_grids_box, only: wnml_kt_grids_box
    implicit none
    integer, intent(in) :: unit

    write (unit, *)
    write (unit, fmt="(' &',a)") "kt_grids_knobs"
    select case (gridopt_switch)          
    case (gridopt_single)
       write (unit, fmt="(' grid_option = ',a)") '"single"'
    case (gridopt_range)
       write (unit, fmt="(' grid_option = ',a)") '"range"'
    case (gridopt_specified)
       write (unit, fmt="(' grid_option = ',a)") '"specified"'
    case (gridopt_box)
       write (unit, fmt="(' grid_option = ',a)") '"box"'
    end select
    write(unit, fmt="(' /')")

    select case (gridopt_switch)
    case (gridopt_single)
       call wnml_kt_grids_single (unit)
    case (gridopt_range)
       call wnml_kt_grids_range (unit)
    case (gridopt_specified)
       call wnml_kt_grids_specified (unit, aky, theta0)
    case (gridopt_box)
       call wnml_kt_grids_box (unit)
    end select
  end subroutine wnml_kt

  !> FIXME : Add documentation  
  subroutine allocate_arrays
    implicit none
    allocate (akx(ntheta0))
    allocate (aky(naky))
    allocate (theta0(ntheta0,naky))
    allocate (ikx(ntheta0))
  end subroutine allocate_arrays

  !> FIXME : Add documentation  
  subroutine get_sizes
    use kt_grids_single, only: init_kt_grids_single, single_get_sizes
    use kt_grids_range, only: init_kt_grids_range, range_get_sizes
    use kt_grids_specified, only: init_kt_grids_specified, specified_get_sizes
    use kt_grids_box, only: init_kt_grids_box, box_get_sizes
    implicit none
    select case (gridopt_switch)
    case (gridopt_single)
       call init_kt_grids_single
       call single_get_sizes (naky, ntheta0, nx, ny)
    case (gridopt_range)
       call init_kt_grids_range
       call range_get_sizes (naky, ntheta0, nx, ny)
    case (gridopt_specified)
       call init_kt_grids_specified
       call specified_get_sizes (naky, ntheta0, nx, ny)
    case (gridopt_box)
       call init_kt_grids_box
       call box_get_sizes (naky, ntheta0, nx, ny)
       reality = .true.
       box = .true.
    end select
  end subroutine get_sizes

  !> FIXME : Add documentation  
  subroutine get_grids
    use kt_grids_single, only: single_get_grids
    use kt_grids_range, only: range_get_grids
    use kt_grids_specified, only: specified_get_grids
    use kt_grids_box, only: box_get_grids
    implicit none
    select case (gridopt_switch)
    case (gridopt_single)
       call single_get_grids (aky, theta0, akx, ikx)
    case (gridopt_range)
       call range_get_grids (aky, theta0, akx, ikx)
    case (gridopt_specified)
       call specified_get_grids (aky, theta0, akx, ikx)
    case (gridopt_box)
       call box_get_grids (aky, theta0, akx, ikx)
    end select
  end subroutine get_grids

  !> FIXME : Add documentation  
  subroutine init_kperp2
    use theta_grid, only: ntgrid, gds2, gds21, gds22, shat
    implicit none
    integer :: ik, it, ig

    if (kp2init) return
    kp2init = .true.

    allocate (kperp2(-ntgrid:ntgrid,ntheta0,naky))
    do ik = 1, naky
       if (aky(ik) == 0.0) then
         do it = 1, ntheta0
             kperp2(:,it,ik) = akx(it)*akx(it)*gds22/(shat*shat)
          end do
       else
          do it = 1, ntheta0
             kperp2(:,it,ik) = aky(ik)*aky(ik) &
                  *(gds2 + 2.0*theta0(it,ik)*gds21 &
                  + theta0(it,ik)*theta0(it,ik)*gds22)
          end do
       end if
    end do

    allocate (inv_kperp2(-ntgrid:ntgrid,ntheta0,naky))

    do ik = 1, naky
       do it = 1, ntheta0
          do ig = -ntgrid, ntgrid
             if (abs(kperp2(ig, it, ik)) > epsilon(0.0)) then
                inv_kperp2(ig, it, ik) = 1.0/kperp2(ig, it, ik)
             else
                inv_kperp2(ig, it, ik) = 0.0
             end if
          end do
       end do
    end do
  end subroutine init_kperp2

  !> FIXME : Add documentation  
  subroutine finish_kt_grids

    implicit none

    if (allocated(aky)) deallocate (akx, aky, theta0, ikx)
    if (allocated(kwork_filter)) deallocate(kwork_filter)
    if (allocated(kperp2)) deallocate(kperp2)
    if (allocated(inv_kperp2)) deallocate(inv_kperp2)
    reality = .false. ; box = .false.
    kp2init = .false.
    initialized = .false.
    call finish_kt_grids_parameters
  end subroutine finish_kt_grids

  !> FIXME : Add documentation  
  subroutine check_kt_grids(report_unit)
!CMR, 22/9/2010:
! add routine to GS2 to perform ingen checking and reporting
    use kt_grids_single, only: check_kt_grids_single
    use kt_grids_range,  only: check_kt_grids_range
    use kt_grids_box,    only: check_kt_grids_box
    use kt_grids_specified, only: check_kt_grids_specified
    implicit none
    integer, intent(in) :: report_unit

    select case (gridopt_switch) 
    case (gridopt_single) 
       call check_kt_grids_single (report_unit)
    case (gridopt_range)
       call check_kt_grids_range (report_unit)
    case (gridopt_specified) 
       call check_kt_grids_specified (report_unit, aky, theta0(:,1))
    case (gridopt_box)
       call check_kt_grids_box (report_unit)
    end select
  end subroutine check_kt_grids

  !> Set the module level config type
  !> Will abort if the module has already been initialised to avoid
  !> inconsistencies.
  subroutine set_kt_grids_config(kt_grids_config_in)
    use mp, only: mp_abort
    type(kt_grids_config_type), intent(in), optional :: kt_grids_config_in
    if (initialized) then
       call mp_abort("Trying to set kt_grids_config when already initialized.", to_screen = .true.)
    end if
    if (present(kt_grids_config_in)) then
       kt_grids_config = kt_grids_config_in
    end if
  end subroutine set_kt_grids_config

#include "kt_grids_auto_gen.inc"
end module kt_grids