init_gs2_diagnostics_new Subroutine

public subroutine init_gs2_diagnostics_new(header)

Read namelist diagnostics_config, initialise submodules, open output file 'run_name.cdf' and create dimensions. !!!!!!!!!!!!!!!!!!!!! Adjust other modules !!!!!!!!!!!!!!!!!!!!!

We should replace parallel_io_capable below with gs2_has_netcdf_parallel once we actually want to allow parallel diagnostics. DD>This is only correct if running in box mode surely?

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Open Text Files (if required) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!! Initialise submodules !!!!!!!!!!!!!!!!!!!!!!!!

Arguments

Type IntentOptional Attributes Name
type(standard_header_type), intent(in) :: header

Header for files with build and run information


Contents


Source Code

  subroutine init_gs2_diagnostics_new(header)
    use kt_grids, only: nx, ny, naky, ntheta0
    use le_grids, only: nlambda, negrid
    use species, only: nspec
    use theta_grid, only: ntgrid
    use gs2_transforms, only: init_transforms
    use diagnostics_config, only: init_diagnostics_config
    use diagnostics_fluxes, only: init_diagnostics_fluxes
    use diagnostics_omega, only: init_diagnostics_omega
    use diagnostics_velocity_space, only: init_diagnostics_velocity_space
    use diagnostics_heating, only: init_diagnostics_heating
    use diagnostics_ascii, only: init_diagnostics_ascii
    use diagnostics_antenna, only: init_diagnostics_antenna
    use diagnostics_nonlinear_convergence, only: init_nonlinear_convergence
    use diagnostics_zonal_transfer, only: init_diagnostics_transfer
    use diagnostics_kinetic_energy_transfer, only: init_diagnostics_kinetic_energy_transfer
    use collisional_heating, only: init_collisional
    use collisions, only: heating, set_heating
    use nonlinear_terms, only: nonlin
    use gs2_save, only: save_many
    use file_utils, only: run_name, error_unit
    use mp, only: proc0, broadcast, mp_abort
    use kt_grids, only: naky, aky
    use gs2_diagnostics, only: check_restart_file_writeable
    use unit_tests, only: debug_message
    use standard_header, only: standard_header_type
    use gs2_metadata, only: create_metadata
    use run_parameters, only: user_comments
    use constants, only: run_name_size
    use neasyf, only: neasyf_open
    use gs2_io, only: define_dims, nc_norms, nc_species, nc_geo, save_input, get_dim_length, nc_grids_mymovie
    implicit none
    !> Header for files with build and run information
    type(standard_header_type), intent(in) :: header
    logical :: ex, accelerated
    character(run_name_size) :: filename
    
    call debug_message(gnostics%verbosity, &
      'gs2_diagnostics_new::init_gs2_diagnostics_new starting')
    call init_diagnostics_config(gnostics)
    call debug_message(gnostics%verbosity, &
      'gs2_diagnostics_new::init_gs2_diagnostics_new initialized config')
    call check_parameters
    call check_restart_file_writeable(gnostics%file_safety_check, &
                                      gnostics%save_for_restart, &
                                      gnostics%save_distfn)
    call debug_message(gnostics%verbosity, &
      'gs2_diagnostics_new::init_gs2_diagnostics_new  checked restart file')
    
    call debug_message(gnostics%verbosity, &
      'gs2_diagnostics_new::init_gs2_diagnostics_new inialized vol avgs')
    
    !!!!!!!!!!!!!!!!!!!!!!!
    !! Adjust other modules
    !!!!!!!!!!!!!!!!!!!!!!!
    save_many = gnostics%save_many

    if (.not. gnostics%write_any) return
    
    gnostics%parallel = .false.
    if (gnostics%enable_parallel) then
       !> We should replace parallel_io_capable below with
       !> [[build_config:gs2_has_netcdf_parallel]] once we actually
       !> want to allow parallel diagnostics.
       if (parallel_io_capable) then
          gnostics%parallel = .true.
       else
          if (proc0) write (*,*) "WARNING: you have selected &
               & enable_parallel but this build does not have &
               & parallel capability."
       end if
    end if
    
    gnostics%user_time_old = 0.0
    
    ! fluxfac is used for summing fields, fluxes etc over ky
    ! Mostly this is not needed, since the average_ky routine in 
    ! volume_averages takes care of the factor... you only need it
    ! if you are manually summing something over ky
    allocate(gnostics%fluxfac(naky))
    gnostics%fluxfac = 0.5
    !<DD>This is only correct if running in box mode surely?
    !    I think this should be if(aky(1)==0.0) fluxfac(1)=1.0 but I may be wrong
    if(aky(1)==0.0) gnostics%fluxfac(1) = 1.0

    if (gnostics%write_heating .and. .not. heating) then
       if (proc0) write(*,'("Warning: Disabling write_heating as collisions:heating is false.")')
       gnostics%write_heating = .false.
    else if (heating .and. .not. &
       (gnostics%write_heating .or. gnostics%write_collisional)) then
       call set_heating(.false.)
    end if

    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    !!! Open Text Files (if required)
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    if (proc0) call set_ascii_file_switches
    if (proc0) call init_diagnostics_ascii(gnostics%ascii_files)
    
    !!!!!!!!!!!!!!!!!!!!!!!!!!!
    ! Initialise submodules
    !!!!!!!!!!!!!!!!!!!!!!!!!!
    call init_diagnostics_fluxes(gnostics)
    call init_diagnostics_omega(gnostics)
    !if (gnostics%write_max_verr) gnostics%write_verr = .true.
    call init_diagnostics_velocity_space(gnostics)
    call init_diagnostics_antenna(gnostics)
    call init_diagnostics_transfer(gnostics)
    call init_collisional(gnostics)

    if (gnostics%write_kinetic_energy_transfer) call init_diagnostics_kinetic_energy_transfer
    if (gnostics%write_heating) call init_diagnostics_heating(gnostics)
    if (nonlin.and.gnostics%use_nonlin_convergence) call init_nonlinear_convergence(gnostics)
    
    filename = trim(trim(run_name)//'.out.nc')

    call debug_message(gnostics%verbosity, &
      'gs2_diagnostics_new::init_gs2_diagnostics_new opening file')
    if (gnostics%parallel.or.proc0) then 
       inquire(file=trim(run_name)//'.out.nc', exist=ex)
       if (gnostics%append_old .and. ex) then
         gnostics%appending=.true.
         gnostics%file_id = neasyf_open(trim(filename), "rw")
         gnostics%nout = get_dim_length(gnostics%file_id, "t")
       else
         gnostics%appending=.false.
         gnostics%file_id = neasyf_open(trim(filename), "w")
         call create_metadata(gnostics%file_id, "GS2 Simulation Data", header, user_comments)
         call debug_message(gnostics%verbosity, &
           'gs2_diagnostics_new::init_gs2_diagnostics_new written metadata')

         ! Write constants/parameters
         call define_dims(gnostics%file_id, gnostics%write_correlation_extend)
         call nc_norms(gnostics%file_id)
         call nc_species(gnostics%file_id)
         call nc_geo(gnostics%file_id)
         call save_input(gnostics%file_id)
         gnostics%nout = 1

         if (gnostics%make_movie) then
           call init_transforms(ntgrid, naky, ntheta0, nlambda, negrid, nspec, nx, ny, accelerated)
           call nc_grids_mymovie(gnostics%file_id)
         end if
       end if
    end if
    call debug_message(gnostics%verbosity, &
      'gs2_diagnostics_new::init_gs2_diagnostics_new opened file')

    ! Vital that other procs know we are appending
    call broadcast(gnostics%appending)
    call broadcast(gnostics%nout)

    call debug_message(gnostics%verbosity, &
      'gs2_diagnostics_new::init_gs2_diagnostics_new finished')
    
  end subroutine init_gs2_diagnostics_new