write_to_unit Subroutine

private subroutine write_to_unit(self, unit)

Writes out the current configuration state to an optionally provided unit. If no unit is provided then we write to output_unit.

Type Bound

gs2_config_type

Arguments

Type IntentOptional Attributes Name
class(gs2_config_type), intent(inout) :: self
integer, intent(in), optional :: unit

Contents

Source Code


Source Code

  subroutine write_to_unit(self, unit)
    use iso_fortran_env, only: output_unit
    implicit none
    ! Note we have to make this intent out as we may want/need to allocate
    ! some components that have not been allocated. If so we do deallocate
    ! so self should be unchanged on exit.
    class(gs2_config_type), intent(in out) :: self
    ! The unit to write to, if not given then will use output_unit. Note we
    ! assume this unit has been opened ready for writing.
    integer, intent(in), optional :: unit
    integer :: local_output_unit, i
    logical :: allocated_flag

    ! Handle optional argument
    local_output_unit = output_unit
    if (present(unit)) local_output_unit = unit

    ! Take care of writing
    call self%ballstab_config%write(local_output_unit)
    call self%collisions_config%write(local_output_unit)
    call self%dist_fn_config%write(local_output_unit)

    allocated_flag = allocated(self%dist_fn_species_config)
    if (.not.allocated_flag) then
       allocate(self%dist_fn_species_config(self%species_config%nspec))
       do i = 1, size(self%dist_fn_species_config)
          self%dist_fn_species_config(i)%index = i
       end do
    end if
    do i = 1, size(self%dist_fn_species_config)
       call self%dist_fn_species_config(i)%write(local_output_unit)
    end do
    if (.not.allocated_flag) deallocate(self%dist_fn_species_config)

    call self%driver_config%write(local_output_unit)
#ifdef WITH_EIG
    call self%eigval_config%write(local_output_unit)
#endif
    call self%fields_config%write(local_output_unit)
#ifdef NEW_DIAG
    if (self%knobs_config%use_old_diagnostics) then
       call self%gs2_diagnostics_config%write(local_output_unit)
    else
       call self%new_gs2_diagnostics_config%write(local_output_unit)
    end if
#else
    call self%gs2_diagnostics_config%write(local_output_unit)
#endif
    call self%hyper_config%write(local_output_unit)
    call self%ingen_config%write(local_output_unit)
    call self%init_g_config%write(local_output_unit)
    call self%knobs_config%write(local_output_unit)
    call self%kt_grids_config%write(local_output_unit)
    call self%kt_grids_box_config%write(local_output_unit)
    call self%kt_grids_range_config%write(local_output_unit)
    call self%kt_grids_single_config%write(local_output_unit)
    call self%kt_grids_specified_config%write(local_output_unit)

    allocated_flag = allocated(self%kt_grids_specified_element_config)
    if (.not.allocated_flag) then
       allocate(self%kt_grids_specified_element_config(max(self%kt_grids_specified_config%naky,self%kt_grids_specified_config%ntheta0)))
       do i = 1, size(self%kt_grids_specified_element_config)
          self%kt_grids_specified_element_config(i)%index = i
       end do
    end if
    do i = 1, size(self%kt_grids_specified_element_config)
       call self%kt_grids_specified_element_config(i)%write(local_output_unit)
    end do
    if (.not.allocated_flag) deallocate(self%kt_grids_specified_element_config)

    call self%layouts_config%write(local_output_unit)
    call self%le_grids_config%write(local_output_unit)
    call self%nonlinear_terms_config%write(local_output_unit)
    call self%normalisations_config%write(local_output_unit)
    call self%optimisation_config%write(local_output_unit)
    call self%parameter_scan_config%write(local_output_unit)
    call self%reinit_config%write(local_output_unit)
    call self%source_config%write(local_output_unit)
    call self%species_config%write(local_output_unit)

    allocated_flag = allocated(self%species_element_config)
    if (.not.allocated_flag) then
       allocate(self%species_element_config(self%species_config%nspec))
       do i = 1, size(self%species_element_config)
          self%species_element_config(i)%index = i
       end do
    end if
    do i = 1, size(self%species_element_config)
       call self%species_element_config(i)%write(local_output_unit)
    end do
    if (.not.allocated_flag) deallocate(self%species_element_config)

    call self%split_nonlinear_terms_config%write(local_output_unit)

    allocated_flag = allocated(self%stir_config)
    if (.not.allocated_flag) then
       allocate(self%stir_config(self%driver_config%nk_stir))
       do i = 1, size(self%stir_config)
          self%stir_config(i)%index = i
       end do
    end if
    do i = 1, size(self%stir_config)
       call self%stir_config(i)%write(local_output_unit)
    end do
    if (.not.allocated_flag) deallocate(self%stir_config)

    call self%theta_grid_config%write(local_output_unit)
    call self%theta_grid_eik_config%write(local_output_unit)
    call self%theta_grid_file_config%write(local_output_unit)
    call self%theta_grid_gridgen_config%write(local_output_unit)
    call self%theta_grid_parameters_config%write(local_output_unit)
    call self%theta_grid_salpha_config%write(local_output_unit)

  end subroutine write_to_unit