• Home
  • Features
  • Pricing
  • Docs
  • Announcements
  • Sign In

gyrokinetics / gs2 / 2021218321

04 Sep 2025 07:44AM UTC coverage: 10.606% (+0.03%) from 10.577%
2021218321

push

gitlab-ci

David Dickinson
Merged in feature/move_more_initialisation_to_init_levels (pull request #1161)

4710 of 44407 relevant lines covered (10.61%)

125698.1 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

1.65
/src/init_g.f90
1
!> This module contains the subroutines which set the initial value of the
2
!> fields and the distribution function.
3
module init_g
4
  use abstract_config, only: abstract_config_type, CONFIG_MAX_NAME_LEN
5
  use constants, only: run_name_size
6
  implicit none
7

8
  private
9

10
  public :: ginit, ginitopt_restart_many, restart_file, get_restart_dir, set_restart_dir
11
  public :: init_init_g, finish_init_g, wnml_init_g, check_init_g, tstart
12
  public :: new_field_init, initial_condition_is_nonadiabatic_dfn, add_restart_dir_to_file
13
  public :: init_g_config_type, set_init_g_config, get_init_g_config
14
  
15
  ! knobs
16
  integer :: ginitopt_switch
17
  integer, parameter :: ginitopt_default = 1,  &
18
       ginitopt_xi = 3, ginitopt_xi2 = 4, ginitopt_rh = 5, ginitopt_zero = 6, &
19
       ginitopt_test3 = 7, ginitopt_convect = 8, &
20
       ginitopt_noise = 10, ginitopt_restart_many = 11, ginitopt_continue = 12, &
21
       ginitopt_nl = 13, ginitopt_kz0 = 14, ginitopt_restart_small = 15, &
22
       ginitopt_nl2 = 16, ginitopt_nl3 = 17, ginitopt_nl4 = 18, & 
23
       ginitopt_nl5 = 19, ginitopt_alf = 20, ginitopt_kpar = 21, &
24
       ginitopt_nl6 = 22, ginitopt_nl7 = 23, ginitopt_gs = 24, ginitopt_recon = 25, &
25
       ginitopt_nl3r = 26, ginitopt_smallflat = 27, ginitopt_harris = 28, &
26
       ginitopt_recon3 = 29, ginitopt_ot = 30, &
27
       ginitopt_zonal_only = 31, ginitopt_single_parallel_mode = 32, &
28
       ginitopt_all_modes_equal = 33, &
29
       ginitopt_default_odd = 34, ginitopt_restart_eig=35, ginitopt_no_zonal = 36, &
30
       ginitopt_stationary_mode = 37, ginitopt_cgyro = 38, ginitopt_random_sine = 39, &
31
       ginitopt_constant = 40
32

33
  real :: width0, dphiinit, phiinit, imfac, refac, zf_init, phifrac
34
  real :: init_spec_pow, k0
35
  real :: den0, upar0, tpar0, tperp0
36
  real :: den1, upar1, tpar1, tperp1
37
  real :: den2, upar2, tpar2, tperp2
38
  real :: tstart, scale, apar0
39
  logical :: chop_side, clean_init, left, even, new_field_init
40
  logical :: initial_condition_is_nonadiabatic_dfn
41
  character (len = run_name_size) :: restart_file !WARNING: This is also defined in gs2_save. This should be addressed
42
  character (len=150) :: restart_dir
43
  integer, dimension(2) :: ikk, itt
44
  integer, dimension(3) :: ikkk,ittt
45
  complex, dimension(3) :: phiamp, aparamp
46
  integer :: restart_eig_id
47
  integer :: max_mode
48

49
  ! These are used for the function ginit_single_parallel_mode, and specify the
50
  !  kparallel to initialize. In the case of  zero magnetic shear, of course, the box 
51
  ! is periodic in the parallel direction, and so only harmonics of the box size 
52
  ! (i.e. ikpar_init) are allowed  EGH</doc>
53
  integer :: ikpar_init
54
  real :: kpar_init
55

56
  !>  This is used  in linear runs with flow shear  in order to track the
57
  !! evolution of a single Lagrangian mode.
58
  integer :: ikx_init
59

60
  ! RN> for recon3
61
  real :: phiinit0 ! amplitude of equilibrium
62
  real :: phiinit_rand ! amplitude of random perturbation
63
  real :: a0,b0 ! amplitude of equilibrium Apara or By 
64
  ! if b0 /= 0, u0 is rescaled to give this By amplitude by overriding a0
65
  ! if a0 /= 0, u0 is rescaled to give this Apara amplitude
66
  logical :: null_phi, null_bpar, null_apar ! nullify fields
67
  ! if use_{Phi,Bpar,Apar} = F, override corresponding flags
68
  integer :: adj_spec ! adjust input parameter of this spec
69
  ! if = 0, just warn if given conditions are not satisfied
70
  character (len=20) :: eq_type = ''
71
  ! equilibrium type = 'sinusoidal', 'porcelli', 'doubleharris'
72
  real :: prof_width=-.05
73
  ! width of porcelli, doubleharris profile
74
  ! if negative, this gives the ratio to the box size
75
  integer :: eq_mode_n=0, eq_mode_u=1
76
  ! mode number in x for sinusoidal equilibrium
77
  logical :: input_check_recon=.false.
78
  complex :: ukxy_pt(3)
79
  ! <RN
80

81
  !> Whether to use the constant_random number
82
  !! generator, which always gives the same
83
  !! random numbers. Used for testing.
84
  logical :: constant_random_flag
85
  
86
  logical, parameter :: debug = .false.
87
  logical :: initialized = .false.
88

89
  interface do_chop_side
90
     module procedure do_chop_side_slice, do_chop_side_full
91
  end interface do_chop_side
92
  
93
  !> Used to represent the input configuration of init_g
94
  type, extends(abstract_config_type) :: init_g_config_type
95
     ! namelist : init_g_knobs
96
     ! indexed : false     
97

98
     !> Amplitude of equilibrium `Apara`: if `a0` is non-zero, \(u_0\) is
99
     !> rescaled to give this `Apara` amplitude
100
     real :: a0 = 0.0
101
     !> Used by [[init_g_knobs:ginit_option]] `"recon3"`: adjust input parameter
102
     !> of this species; if = 0, just warn if given conditions are not satisfied
103
     !>
104
     !> FIXME: What input parameter, what conditions?
105
     integer :: adj_spec = 0
106
     !> Used by [[init_g_knobs:ginit_option]] `"nl3r"`: set amplitude of `apar`
107
     !> if [[init_g_knobs:width0]] is negative
108
     real :: apar0 = 0.0
109
     !> Used in initialization for the Orszag-Tang 2D vortex problem
110
     !> ([[init_g_knobs:ginit_option]] `"ot"`). Controls size of `jpar` term.
111
     !> FIXME: Reference equations?
112
     complex, dimension(3) :: aparamp = cmplx(0.0,0.0)
113
     !> Amplitude of equilibrium `By`: if `b0` is non-zero, \(u_0\) is
114
     !> rescaled to give this `By` amplitude by overriding [[init_g_knobs:a0]]
115
     real :: b0 = 0.0
116
     !> Rarely needed. Forces asymmetry into initial condition. Warning: This
117
     !> does not behave as one may expect in flux tube simulations (see
118
     !> clean_init), this can be important as the default is to use chop_side
119
     logical :: chop_side = .true.
120
     !> Used with [[init_g_knobs:ginit_option]] `"noise"`. Ensures that in flux
121
     !> tube simulations the connected boundary points are initialised to the
122
     !> same value. Also allows for [[init_g_knobs:chop_side]] to behave
123
     !> correctly in flux tube simulations.
124
     logical :: clean_init = .true.
125
     !> Use the constant_random number generator, which always gives the same
126
     !> random numbers. Useful for testing.
127
     logical :: constant_random_flag = .false.
128
     !> Amplitude of zeroth density perturbation for [[init_g_knobs:ginit_option]]
129
     !> options:
130
     !>
131
     !> - `"kpar"` (see [[init_g:ginit_kpar]])
132
     !> - `"kz0"` (see [[init_g:ginit_kz0]])
133
     !> - `"nl3"` (see [[init_g:ginit_nl3]])
134
     !> - `"nl3r"` (see [[init_g:ginit_nl3r]])
135
     !> - `"nl7"` (see [[init_g:ginit_nl7]])
136
     !> - `"ot"` (see [[init_g:ginit_ot]])
137
     !> - `"recon"` (see [[init_g:ginit_recon]])
138
     real :: den0 = 1.0
139
     !> Amplitude of first density perturbation for [[init_g_knobs:ginit_option]]
140
     !> options:
141
     !>
142
     !> - `"gs"` (see [[init_g:ginit_gs]])
143
     !> - `"kpar"` (see [[init_g:ginit_kpar]])
144
     !> - `"nl3"` (see [[init_g:ginit_nl3]])
145
     !> - `"nl3r"` (see [[init_g:ginit_nl3r]])
146
     !> - `"nl7"` (see [[init_g:ginit_nl7]])
147
     !> - `"recon"` (see [[init_g:ginit_recon]])
148
     !> - `"recon3"` (see [[init_g:ginit_recon3]])
149
     real :: den1 = 0.0
150
     !> Amplitude of second density perturbation for [[init_g_knobs:ginit_option]]
151
     !> options:
152
     !>
153
     !> - `"kpar"` (see [[init_g:ginit_kpar]])
154
     !> - `"kz0"` (see [[init_g:ginit_kz0]])
155
     !> - `"nl3"` (see [[init_g:ginit_nl3]])
156
     !> - `"nl3r"` (see [[init_g:ginit_nl3r]])
157
     !> - `"nl7"` (see [[init_g:ginit_nl7]])
158
     !> - `"recon"` (see [[init_g:ginit_recon]])
159
     !> - `"recon3"` (see [[init_g:ginit_recon3]])
160
     real :: den2 = 0.0
161
     !> Amplitude of \(\phi\) for `"nl7"` (see [[init_g:ginit_nl7]])
162
     real :: dphiinit = 1.0
163
     !> Mode number in \(x\) for the sinusoidal equilbrium option of
164
     !> [[init_g_knobs:ginit_option]] `"recon3"` (see [[init_g:ginit_recon3]]),
165
     !> applies to density and temperatures
166
     integer :: eq_mode_n = 0
167
     !> Mode number in \(x\) for the sinusoidal equilbrium option of
168
     !> [[init_g_knobs:ginit_option]] `"recon3"` (see [[init_g:ginit_recon3]]),
169
     !> applies to parallel velocity
170
     integer :: eq_mode_u = 1
171
     !> Equilbrium choice for [[init_g_knobs:ginit_option]] `"recon3"` (see
172
     !> [[init_g:ginit_recon3]]). Choices are:
173
     !>
174
     !> - `"sinusoidal"`
175
     !> - `"porcelli"`
176
     !> - `"doubleharris"`
177
     character(len = 20) :: eq_type = 'sinusoidal'
178
     !> Sometimes initial conditions have definite parity; this picks the parity
179
     !> in those cases. Affects the following choices of
180
     !> [[init_g_knobs:ginit_option]]:
181
     !>
182
     !> - `"nl3"` (see [[init_g:ginit_nl3]])
183
     !> - `"nl3r"` (see [[init_g:ginit_nl3r]])
184
     !> - `"nl7"` (see [[init_g:ginit_nl7]])
185
     !> - `"recon"` (see [[init_g:ginit_recon]])
186
     !> - `"recon3"` (see [[init_g:ginit_recon3]])
187
     logical :: even = .true.
188
     !> Method for initialising `g`. There are many possible options, but the
189
     !> typical ones are:
190
     !>
191
     !>   - `"default"`: Gaussian in \(\theta\). See [[init_g_knobs:phiinit]],
192
     !>     [[init_g_knobs:width0]], [[init_g_knobs:chop_side]]
193
     !>   - `"default_odd"`: Guassian in \(\theta\) multiplied by \(\sin(\theta -
194
     !>     \theta_0)\). See [[init_g_knobs:phiinit]], [[init_g_knobs:width0]],
195
     !>     [[init_g_knobs:chop_side]]
196
     !>   - `"noise"`: Noise along field line. The recommended (but not default)
197
     !>     selection. See [[init_g_knobs:phiinit]], [[init_g_knobs:zf_init]]
198
     !>   - `"restart", "many"`: Restart, using `g` from restart files.
199
     !>   - `"single_parallel_mode"`: Initialise only with a single parallel mode
200
     !>     specified by either [[init_g_knobs:ikpar_init]] for periodic
201
     !>     boundary conditions or [[init_g_knobs:kpar_init]] for linked
202
     !>     boundary conditions. Intended for linear calculations.
203
     !>   - `"eig_restart"`: Uses the restart files written by the
204
     !>     eigensolver. Also see [[init_g_knobs:restart_eig_id]].
205
     !>   - `"random_sine"`: This option is notable as it attempts to make sure
206
     !>     that the initial condition satisfies the parallel boundary condition.
207
     !>
208
     !> All the options are detailed further in the [initialisation options
209
     !> documentation](../user_manual/initialisation.html)
210
     character(len = 20) :: ginit_option = "default"
211
     !> \(k_y\) indices of two modes to initialise for certain options
212
     integer, dimension(2) :: ikk = [1, 2]
213
     !> \(k_y\) indices of three modes to initialise for certain options
214
     integer, dimension(3) :: ikkk = [1, 2, 2]
215
     !> Parallel mode number to initialise for [[init_g_knobs:ginit_option]]
216
     !> `"single_parallel_mode"` with periodic boundary conditions
217
     integer :: ikpar_init = 0
218
     !> If greater than zero, initialise only the given \(k_x\) with
219
     !> [[init_g_knobs:ginit_option]] `"noise"`. This is useful for linear runs
220
     !> with flow shear, to track the evolution of a single Lagrangian mode.
221
     integer :: ikx_init = -1
222
     !> Amplitude of imaginary part of \(\phi\) for various
223
     !> [[init_g_knobs:ginit_option]] options
224
     real :: imfac = 0.0
225
     !> Initial spectrum power index. with
226
     !> [[init_g_knobs:ginit_option]] `"noise"`.
227
     real :: init_spec_pow = 0.0
228
     !> Do we want to include the explicit source terms and
229
     !> related timesteps when saving/restoring from the restart file.
230
     logical :: include_explicit_source_in_restart = .true.
231
     !> If true then the initial condition is used to set the non-adiabatic
232
     !> distribution function rather than the `g` evolved by GS2.
233
     logical :: initial_condition_is_nonadiabatic_dfn = .false.
234
     !> Print some debug information for [[init_g_knobs:ginit_option]] `"recon3"`
235
     logical :: input_check_recon = .false.
236
     !> \(k_x\) indices of two modes to initialise for certain options
237
     integer, dimension(2) :: itt = [1, 2]     
238
     !> \(k_x\) indices of three modes to initialise for certain options
239
     integer, dimension(3) :: ittt = [1, 2, 2]     
240
     !> Used in [[init_g_knobs:ginit_option]] "harris" and "convect".
241
     real :: k0 = 1.0
242
     !> Parallel mode number to initialise for [[init_g_knobs:ginit_option]]
243
     !> `"single_parallel_mode"` with linked boundary conditions
244
     real :: kpar_init = 0.0
245
     !> If [[init_g_knobs:chop_side]] is true, chop out left side in theta if
246
     !> true, right side if false. Applies to: FIXME: list of initial conditions
247
     logical :: left = .true.
248
     !> The maximum mode number to initialise for [[init_g_knobs:ginit_option]]
249
     !> `"random_sine"`. Actual maximum used will be lower of max_mode and `ntheta/8`
250
     integer :: max_mode = 128
251
     !> Change fields implicit initialisation somehow
252
     !>
253
     !> FIXME: Add documentation
254
     logical :: new_field_init = .true.
255
     !> "Nullify fields". Used by [[init_g_knobs:ginit_option]] `"recon3"`
256
     !>
257
     !> FIXME: Add documentation
258
     logical :: null_apar = .false.
259
     !> "Nullify fields". Used by [[init_g_knobs:ginit_option]] `"recon3"`
260
     !>
261
     !> FIXME: Add documentation
262
     logical :: null_bpar = .false.
263
     !> "Nullify fields". Used by [[init_g_knobs:ginit_option]] `"recon3"`
264
     !>
265
     !> FIXME: Add documentation
266
     logical :: null_phi = .false.
267
     !> Used in initialization for the Orszag-Tang 2D vortex problem.
268
     !>
269
     !> FIXME: expand
270
     complex, dimension(3) :: phiamp = cmplx(0.0,0.0)
271
     !> If doing multiple flux tube calculations, multiply
272
     !> [[init_g_knobs:phiinit]] by `(job * phifrac + 1)`. Allows for ensemble
273
     !> averaging of multiple flux tube calculations
274
     real :: phifrac = 0.1
275
     !> Average amplitude of initial perturbation of each Fourier mode. Used by
276
     !> most [[init_g_knobs:ginit_option]] options
277
     real :: phiinit = 1.0
278
     !> Amplitude of equilibrium. Used by [[init_g_knobs:ginit_option]] `"recon3"`
279
     real :: phiinit0 = 0.0
280
     !> Amplitude of random perturbation. Used by [[init_g_knobs:ginit_option]] `"recon3"`
281
     real :: phiinit_rand = 0.0
282
     !> Which processor is responsible for saving/reading potentials to/from restart
283
     !> files. If <0 then all procs write to restart files. If >= nproc then set to
284
     !> proc_to_save_fields = mod(proc_to_save_fields, nproc)
285
     integer :: proc_to_save_fields = 0
286
     !> Width of "porcelli", "doubleharris" profiles in
287
     !> [[init_g_knobs:ginit_option]] `"recon3"`. If negative, this gives the
288
     !> ratio to the box size
289
     real :: prof_width = -0.1
290
     !> Restart from many restart files. If false, use a single restart file:
291
     !> this requires GS2 to have been built with parallel netCDF.
292
     logical :: read_many = .false.
293
     !> Amplitude of real part of \(\phi\) for various
294
     !> [[init_g_knobs:ginit_option]] options
295
     real :: refac = 1.0
296
     !> Directory to read/write restart files to/from. Make sure this exists
297
     !> before running (see [[gs2_diagnostics_knobs:file_safety_check]])
298
     character(len = 150) :: restart_dir = "./"
299
     !> Used to select with eigensolver generated restart file to load. Sets
300
     !> `<id>` in `restart_file//eig_<id>//.<proc>` string used to set
301
     !> filename. Note that this is zero indexed.
302
     integer :: restart_eig_id = 0
303
     !> Basename of restart files
304
     !>
305
     !> @note gets a smart default
306
     character(len = run_name_size) :: restart_file = "restart_file_not_set.nc"
307
     !> Rescale amplitudes of fields for restart [[init_g_knobs:ginit_option]]
308
     !> options such as `"restart"`. Note that if `scale` is negative, the
309
     !> fields are scaled by `-scale / max(abs(phi))`!
310
     real :: scale = 1.0
311
     !> Amplitude of zeroth parallel temperature perturbation for
312
     !> [[init_g_knobs:ginit_option]] options:
313
     !>
314
     !> - `"kpar"` (see [[init_g:ginit_kpar]])
315
     !> - `"kz0"` (see [[init_g:ginit_kz0]])
316
     !> - `"nl3"` (see [[init_g:ginit_nl3]])
317
     !> - `"nl3r"` (see [[init_g:ginit_nl3r]])
318
     !> - `"nl7"` (see [[init_g:ginit_nl7]])
319
     !> - `"ot"` (see [[init_g:ginit_ot]])
320
     !> - `"recon"` (see [[init_g:ginit_recon]])
321
     real :: tpar0 = 0.0
322
     !> Amplitude of first parallel temperature perturbation for
323
     !> [[init_g_knobs:ginit_option]] options:
324
     !>
325
     !> - `"gs"` (see [[init_g:ginit_gs]])
326
     !> - `"kpar"` (see [[init_g:ginit_kpar]])
327
     !> - `"nl3"` (see [[init_g:ginit_nl3]])
328
     !> - `"nl3r"` (see [[init_g:ginit_nl3r]])
329
     !> - `"nl7"` (see [[init_g:ginit_nl7]])
330
     !> - `"recon"` (see [[init_g:ginit_recon]])
331
     !> - `"recon3"` (see [[init_g:ginit_recon3]])
332
     real :: tpar1 = 0.0
333
     !> Amplitude of second parallel temperature perturbation for
334
     !> [[init_g_knobs:ginit_option]] options:
335
     !>
336
     !> - `"kpar"` (see [[init_g:ginit_kpar]])
337
     !> - `"kz0"` (see [[init_g:ginit_kz0]])
338
     !> - `"nl3"` (see [[init_g:ginit_nl3]])
339
     !> - `"nl3r"` (see [[init_g:ginit_nl3r]])
340
     !> - `"nl7"` (see [[init_g:ginit_nl7]])
341
     !> - `"recon"` (see [[init_g:ginit_recon]])
342
     !> - `"recon3"` (see [[init_g:ginit_recon3]])
343
     real :: tpar2 = 0.0
344
     !> Amplitude of zeroth perpendicular temperature perturbation for
345
     !> [[init_g_knobs:ginit_option]] options:
346
     !>
347
     !> - `"kpar"` (see [[init_g:ginit_kpar]])
348
     !> - `"kz0"` (see [[init_g:ginit_kz0]])
349
     !> - `"nl3"` (see [[init_g:ginit_nl3]])
350
     !> - `"nl3r"` (see [[init_g:ginit_nl3r]])
351
     !> - `"nl7"` (see [[init_g:ginit_nl7]])
352
     !> - `"ot"` (see [[init_g:ginit_ot]])
353
     !> - `"recon"` (see [[init_g:ginit_recon]])
354
     real :: tperp0 = 0.0
355
     !> Amplitude of first perpendicular temperature perturbation for
356
     !> [[init_g_knobs:ginit_option]] options:
357
     !>
358
     !> - `"gs"` (see [[init_g:ginit_gs]])
359
     !> - `"kpar"` (see [[init_g:ginit_kpar]])
360
     !> - `"nl3"` (see [[init_g:ginit_nl3]])
361
     !> - `"nl3r"` (see [[init_g:ginit_nl3r]])
362
     !> - `"nl7"` (see [[init_g:ginit_nl7]])
363
     !> - `"recon"` (see [[init_g:ginit_recon]])
364
     !> - `"recon3"` (see [[init_g:ginit_recon3]])
365
     real :: tperp1 = 0.0
366
     !> Amplitude of second perpendicular temperature perturbation for
367
     !> [[init_g_knobs:ginit_option]] options:
368
     !>
369
     !> - `"kpar"` (see [[init_g:ginit_kpar]])
370
     !> - `"kz0"` (see [[init_g:ginit_kz0]])
371
     !> - `"nl3"` (see [[init_g:ginit_nl3]])
372
     !> - `"nl3r"` (see [[init_g:ginit_nl3r]])
373
     !> - `"nl7"` (see [[init_g:ginit_nl7]])
374
     !> - `"recon"` (see [[init_g:ginit_recon]])
375
     !> - `"recon3"` (see [[init_g:ginit_recon3]])
376
     real :: tperp2 = 0.0
377
     !> Force `t = tstart` at beginning of run
378
     real :: tstart = 0.0
379
     !> Perturbation amplitude of parallel velocity? Used by
380
     !> [[init_g_knobs:ginit_option]] `"recon3"`
381
     !>
382
     !> FIXME: Add documentation
383
     complex, dimension(3) :: ukxy_pt = cmplx(0.,0.)
384
     !> Amplitude of zeroth parallel velocity perturbation for
385
     !> [[init_g_knobs:ginit_option]] options:
386
     !>
387
     !> - `"kpar"` (see [[init_g:ginit_kpar]])
388
     !> - `"kz0"` (see [[init_g:ginit_kz0]])
389
     !> - `"nl3"` (see [[init_g:ginit_nl3]])
390
     !> - `"nl3r"` (see [[init_g:ginit_nl3r]])
391
     !> - `"nl7"` (see [[init_g:ginit_nl7]])
392
     !> - `"ot"` (see [[init_g:ginit_ot]])
393
     !> - `"recon"` (see [[init_g:ginit_recon]])
394
     real :: upar0 = 0.0
395
     !> Amplitude of first parallel velocity perturbation for
396
     !> [[init_g_knobs:ginit_option]] options:
397
     !>
398
     !> - `"gs"` (see [[init_g:ginit_gs]])
399
     !> - `"kpar"` (see [[init_g:ginit_kpar]])
400
     !> - `"nl3"` (see [[init_g:ginit_nl3]])
401
     !> - `"nl3r"` (see [[init_g:ginit_nl3r]])
402
     !> - `"nl7"` (see [[init_g:ginit_nl7]])
403
     !> - `"recon"` (see [[init_g:ginit_recon]])
404
     !> - `"recon3"` (see [[init_g:ginit_recon3]])
405
     real :: upar1 = 0.0
406
     !> Amplitude of second parallel velocity perturbation for
407
     !> [[init_g_knobs:ginit_option]] options:
408
     !>
409
     !> - `"kpar"` (see [[init_g:ginit_kpar]])
410
     !> - `"kz0"` (see [[init_g:ginit_kz0]])
411
     !> - `"nl3"` (see [[init_g:ginit_nl3]])
412
     !> - `"nl3r"` (see [[init_g:ginit_nl3r]])
413
     !> - `"nl7"` (see [[init_g:ginit_nl7]])
414
     !> - `"recon"` (see [[init_g:ginit_recon]])
415
     !> - `"recon3"` (see [[init_g:ginit_recon3]])
416
     real :: upar2 = 0.0
417
     !> Width of initial perturbation Gaussian envelope in \(\theta\)
418
     real :: width0 = -3.5
419
     !> Amplitude of initial zonal flow perturbations relative to other modes
420
     real :: zf_init = 1.0
421
#include "init_g_overrides_and_bound_auto_gen.inc"
422
     procedure :: set_smart_defaults => set_smart_defaults_local
423
  end type init_g_config_type
424
  
425
  type(init_g_config_type) :: init_g_config
426
  
427
contains
428

429
  !> FIXME : Add documentation
430
  subroutine wnml_init_g(unit)
×
431
    implicit none
432
    integer, intent(in) :: unit
433
    call init_g_config%write(unit)
×
434
  end subroutine wnml_init_g
×
435

436
  !> FIXME : Add documentation  
437
  subroutine check_init_g(report_unit)
×
438
    use run_parameters, only : delt_option_switch, delt_option_auto
439
    use species, only : spec, has_electron_species
440
    use warning_helpers, only: not_exactly_equal
441
    implicit none
442
    integer, intent(in) :: report_unit
443
    select case (ginitopt_switch)
×
444
    case (ginitopt_default)
445
       write (report_unit, fmt="('Initial conditions:')")
×
446
       write (report_unit, fmt="('  Amplitude:        ',f10.4)") phiinit
×
447
       write (report_unit, fmt="('  Width in theta:   ',f10.4)") width0
×
448
       if (chop_side) then
×
449
          write (report_unit, fmt="('  Parity:   none')") 
×
450
       else
451
          write (report_unit, fmt="('  Parity:   even')") 
×
452
       end if
453

454
    case (ginitopt_kz0)
455
       write (report_unit, fmt="('Initial conditions:')")
×
456
       write (report_unit, fmt="('  Amplitude:        ',f10.4)") phiinit
×
457
       write (report_unit, fmt="('  Constant along field line',f10.4)") width0
×
458
       if (chop_side) then
×
459
          write (report_unit, *) 
×
460
          write (report_unit, fmt="('################# WARNING #######################')")
×
461
          write (report_unit, fmt="('  Parity:   none')") 
×
462
          write (report_unit, fmt="('THIS IS PROBABLY AN ERROR.')") 
×
463
          write (report_unit, fmt="('Remedy: set chop_side = .false. in init_g_knobs.')") 
×
464
          write (report_unit, fmt="('################# WARNING #######################')")
×
465
          write (report_unit, *) 
×
466
       end if
467

468
    case (ginitopt_noise)
469
       write (report_unit, fmt="('Initial conditions:')")
×
470
       write (report_unit, fmt="('  Amplitude:        ',f10.4)") phiinit
×
471
       write (report_unit, fmt="('  Noise along field line.')") 
×
472
       if (not_exactly_equal(zf_init, 1.)) then
×
473
          write (report_unit, fmt="('  Zonal flows adjusted by factor of zf_init = ',f10.4)") zf_init
×
474
       end if
475

476
    case (ginitopt_kpar)
477
       write (report_unit, fmt="('Initial conditions:')")
×
478
       write (report_unit, fmt="('  Amplitude:             ',f10.4)") phiinit
×
479
       write (report_unit, fmt="('  Real part multiplier:  ',f10.4)") refac
×
480
       write (report_unit, fmt="('  Imag part multiplier:  ',f10.4)") imfac
×
481
       if (width0 > 0.) then
×
482
          write (report_unit, fmt="('  Gaussian envelope in theta with width:  ',f10.4)") width0
×
483
       end if
484
       if (chop_side) then
×
485
          write (report_unit, *) 
×
486
          write (report_unit, fmt="('################# WARNING #######################')")
×
487
          write (report_unit, fmt="('  Parity:   none')") 
×
488
          write (report_unit, fmt="('THIS IS PROBABLY AN ERROR.')") 
×
489
          write (report_unit, fmt="('Remedy: set chop_side = .false. in init_g_knobs.')") 
×
490
          write (report_unit, fmt="('################# WARNING #######################')")
×
491
          write (report_unit, *) 
×
492
       end if
493
       if (den0 > epsilon(0.0) .or. den1 > epsilon(0.0) .or. den2 > epsilon(0.0)) then
×
494
          write (report_unit, *) 
×
495
          write (report_unit, fmt="('Initial density perturbation of the form:')")
×
496
          write (report_unit, fmt="('den0   + den1 * cos(theta) + den2 * cos(2.*theta)')")
×
497
          write (report_unit, *) 
×
498
          write (report_unit, fmt="('with den0 =',f7.4,' den1 = ',f7.4,' den2 = ',f7.4)") den0, den1, den2
×
499
       end if
500
       if (upar0 > epsilon(0.0) .or. upar1 > epsilon(0.0) .or. upar2 > epsilon(0.0)) then
×
501
          write (report_unit, *) 
×
502
          write (report_unit, fmt="('Initial parallel velocity perturbation of the form:')")
×
503
          write (report_unit, fmt="('upar0   + upar1 * sin(theta) + upar2 * sin(2.*theta)')")
×
504
          write (report_unit, fmt="('90 degrees out of phase with other perturbations.')")
×
505
          write (report_unit, *) 
×
506
          write (report_unit, fmt="('with upar0 =',f7.4,' upar1 = ',f7.4,' upar2 = ',f7.4)") upar0, upar1, upar2
×
507
       end if
508
       if (tpar0 > epsilon(0.0) .or. tpar1 > epsilon(0.0) .or. tpar2 > epsilon(0.0)) then
×
509
          write (report_unit, *) 
×
510
          write (report_unit, fmt="('Initial Tpar perturbation of the form:')")
×
511
          write (report_unit, fmt="('tpar0   + tpar1 * cos(theta) + tpar2 * cos(2.*theta)')")
×
512
          write (report_unit, *) 
×
513
          write (report_unit, fmt="('with tpar0 =',f7.4,' tpar1 = ',f7.4,' tpar2 = ',f7.4)") tpar0, tpar1, tpar2
×
514
       end if
515
       if (tperp0 > epsilon(0.0) .or. tperp1 > epsilon(0.0) .or. tperp2 > epsilon(0.0)) then
×
516
          write (report_unit, *) 
×
517
          write (report_unit, fmt="('Initial Tperp perturbation of the form:')")
×
518
          write (report_unit, fmt="('tperp0   + tperp1 * cos(theta) + tperp2 * cos(2.*theta)')")
×
519
          write (report_unit, *) 
×
520
          write (report_unit, fmt="('with tperp0 =',f7.4,' tperp1 = ',f7.4,' tperp2 = ',f7.4)") tperp0, tperp1, tperp2
×
521
       end if
522
       if (has_electron_species(spec)) then
×
523
          write (report_unit, *) 
×
524
          write (report_unit, fmt="('Field line average of g_electron subtracted off.')")
×
525
       end if
526

527
    case (ginitopt_gs)
528
       write (report_unit, fmt="('Initial conditions:')")
×
529
       write (report_unit, fmt="('  Randomly phased kpar=1 sines and cosines')") 
×
530
       write (report_unit, fmt="('  in density, upar, tpar, or tperp.')") 
×
531
       write (report_unit, fmt="('  Real part amplitude:  ',f10.4)") refac*phiinit
×
532
       write (report_unit, fmt="('  Imag part amplitude:  ',f10.4)") imfac*phiinit
×
533
       if (abs( den1)  > epsilon(0.0)) write (report_unit, fmt="('  Density amplitude:  ',f10.4)") den1
×
534
       if (abs( upar1) > epsilon(0.0)) write (report_unit, fmt="('  Upar amplitude:  ',f10.4)") upar1
×
535
       if (abs( tpar1) > epsilon(0.0)) write (report_unit, fmt="('  Tpar amplitude:  ',f10.4)") tpar1
×
536
       if (abs(tperp1) > epsilon(0.0)) write (report_unit, fmt="('  Tperp amplitude:  ',f10.4)") tperp1
×
537

538
    case (ginitopt_nl)
539
       write (report_unit, fmt="('Initial conditions:')")
×
540
       write (report_unit, fmt="('At most two k_perps excited, with amplitude = ',f10.4)") phiinit
×
541
       write (report_unit, fmt="(' First k_perp has ik = ',i3,' it = ',i3)") ikk(1), itt(1)
×
542
       write (report_unit, fmt="('Second k_perp has ik = ',i3,' it = ',i3)") ikk(2), itt(2)
×
543
       if (chop_side) then
×
544
          write (report_unit, fmt="('  Parity:   none')") 
×
545
       else
546
          write (report_unit, fmt="('  Parity:   even')") 
×
547
       end if
548
       write (report_unit, fmt="('Reality condition is enforced.')")
×
549
       
550
    case (ginitopt_nl2)
551
       write (report_unit, fmt="('Initial conditions:')")
×
552
       write (report_unit, fmt="('At most two k_perps excited, with amplitude = ',f10.4)") phiinit
×
553
       write (report_unit, fmt="(' First k_perp has ik = ',i3,' it = ',i3)") ikk(1), itt(1)
×
554
       write (report_unit, fmt="('Second k_perp has ik = ',i3,' it = ',i3)") ikk(2), itt(2)
×
555
       if (chop_side) then
×
556
          write (report_unit, fmt="('  Parity:   none')") 
×
557
       else
558
          write (report_unit, fmt="('  Parity:   even')") 
×
559
       end if
560
       write (report_unit, fmt="('Reality condition is enforced.')")
×
561
       write (report_unit, fmt="('g perturbation proportional to (1+v_parallel)*sin(theta)')")
×
562

563
    case (ginitopt_nl3)
564
       write (report_unit, fmt="('Initial conditions:')")
×
565
       write (report_unit, fmt="('At most two k_perps excited, with amplitude = ',f10.4)") phiinit
×
566
       write (report_unit, fmt="(' First k_perp has ik = ',i3,' it = ',i3)") ikk(1), itt(1)
×
567
       write (report_unit, fmt="('Second k_perp has ik = ',i3,' it = ',i3)") ikk(2), itt(2)
×
568
       write (report_unit, fmt="('  Real part multiplied by:  ',f10.4)") refac
×
569
       write (report_unit, fmt="('  Imag part multiplied by:  ',f10.4)") imfac
×
570
       if (width0 > 0.) then
×
571
          write (report_unit, fmt="('  Gaussian envelope in theta with width:  ',f10.4)") width0
×
572
       end if
573
       if (chop_side) then
×
574
          write (report_unit, fmt="('  Parity:   none')") 
×
575
       else
576
          write (report_unit, fmt="('  Parity:   even')") 
×
577
       end if
578
       write (report_unit, fmt="('Reality condition is enforced.')")
×
579
       if (den0 > epsilon(0.0) .or. den1 > epsilon(0.0) .or. den2 > epsilon(0.0)) then
×
580
          write (report_unit, *) 
×
581
          write (report_unit, fmt="('Initial density perturbation of the form:')")
×
582
          write (report_unit, fmt="('den0   + den1 * cos(theta) + den2 * cos(2.*theta)')")
×
583
          write (report_unit, *) 
×
584
          write (report_unit, fmt="('with den0 =',f7.4,' den1 = ',f7.4,' den2 = ',f7.4)") den0, den1, den2
×
585
       end if
586
       if (upar0 > epsilon(0.0) .or. upar1 > epsilon(0.0) .or. upar2 > epsilon(0.0)) then
×
587
          write (report_unit, *) 
×
588
          write (report_unit, fmt="('Initial parallel velocity perturbation of the form:')")
×
589
          write (report_unit, fmt="('upar0   + upar1 * cos(theta) + upar2 * cos(2.*theta)')")
×
590
          write (report_unit, fmt="('90 degrees out of phase with other perturbations.')")
×
591
          write (report_unit, *) 
×
592
          write (report_unit, fmt="('with upar0 =',f7.4,' upar1 = ',f7.4,' upar2 = ',f7.4)") upar0, upar1, upar2
×
593
       end if
594
       if (tpar0 > epsilon(0.0) .or. tpar1 > epsilon(0.0) .or. tpar2 > epsilon(0.0)) then
×
595
          write (report_unit, *) 
×
596
          write (report_unit, fmt="('Initial Tpar perturbation of the form:')")
×
597
          write (report_unit, fmt="('tpar0   + tpar1 * cos(theta) + tpar2 * cos(2.*theta)')")
×
598
          write (report_unit, *) 
×
599
          write (report_unit, fmt="('with tpar0 =',f7.4,' tpar1 = ',f7.4,' tpar2 = ',f7.4)") tpar0, tpar1, tpar2
×
600
       end if
601
       if (tperp0 > epsilon(0.0) .or. tperp1 > epsilon(0.0) .or. tperp2 > epsilon(0.0)) then
×
602
          write (report_unit, *) 
×
603
          write (report_unit, fmt="('Initial Tperp perturbation of the form:')")
×
604
          write (report_unit, fmt="('tperp0   + tperp1 * cos(theta) + tperp2 * cos(2.*theta)')")
×
605
          write (report_unit, *) 
×
606
          write (report_unit, fmt="('with tperp0 =',f7.4,' tperp1 = ',f7.4,' tperp2 = ',f7.4)") tperp0, tperp1, tperp2
×
607
       end if
608
       
609
    case (ginitopt_nl4)
610
       write (report_unit, fmt="('Initial conditions:')")
×
611
       write (report_unit, *) 
×
612
       write (report_unit, fmt="('################# WARNING #######################')")
×
613
       write (report_unit, fmt="('Under development for study of secondary instabilities.')")
×
614
       write (report_unit, fmt="('Scale factor:   ',f10.4)") scale
×
615
       write (report_unit, fmt="('THIS IS PROBABLY AN ERROR.')") 
×
616
       write (report_unit, fmt="('################# WARNING #######################')")
×
617
       write (report_unit, *) 
×
618

619
    case (ginitopt_nl5)
620
       write (report_unit, fmt="('Initial conditions:')")
×
621
       write (report_unit, *) 
×
622
       write (report_unit, fmt="('################# WARNING #######################')")
×
623
       write (report_unit, fmt="('Under development for study of secondary instabilities.')")
×
624
       write (report_unit, fmt="('Scale factor:   ',f10.4)") scale
×
625
       write (report_unit, fmt="('THIS IS PROBABLY AN ERROR.')") 
×
626
       write (report_unit, fmt="('################# WARNING #######################')")
×
627
       write (report_unit, *) 
×
628

629
    case (ginitopt_nl6)
630
       write (report_unit, fmt="('Initial conditions:')")
×
631
       write (report_unit, *) 
×
632
       write (report_unit, fmt="('################# WARNING #######################')")
×
633
       write (report_unit, fmt="('Change amplitude of a particular mode.')")
×
634
       write (report_unit, fmt="('Scale factor:   ',f10.4)") scale
×
635
       write (report_unit, fmt="('THIS IS PROBABLY AN ERROR.')") 
×
636
       write (report_unit, fmt="('################# WARNING #######################')")
×
637
       write (report_unit, *) 
×
638

639
    case (ginitopt_xi)
640
       write (report_unit, fmt="('Initial conditions:')")
×
641
       write (report_unit, *) 
×
642
       write (report_unit, fmt="('################# WARNING #######################')")
×
643
       write (report_unit, fmt="('Perturbation proportional to pitch angle.')")
×
644
       write (report_unit, fmt="('THIS IS PROBABLY AN ERROR.')") 
×
645
       write (report_unit, fmt="('################# WARNING #######################')")
×
646
       write (report_unit, *) 
×
647

648
    case (ginitopt_xi2)
649
       write (report_unit, fmt="('Initial conditions:')")
×
650
       write (report_unit, *) 
×
651
       write (report_unit, fmt="('################# WARNING #######################')")
×
652
       write (report_unit, fmt="('Perturbation proportional to function of pitch angle.')")
×
653
       write (report_unit, fmt="('THIS IS PROBABLY AN ERROR.')") 
×
654
       write (report_unit, fmt="('################# WARNING #######################')")
×
655
       write (report_unit, *) 
×
656

657
    case (ginitopt_rh)
658
       write (report_unit, fmt="('Initial conditions:')")
×
659
       write (report_unit, *) 
×
660
       write (report_unit, fmt="('################# WARNING #######################')")
×
661
       write (report_unit, fmt="('Maxwellian perturbation in ik=1 mode.')")
×
662
       write (report_unit, fmt="('THIS IS PROBABLY AN ERROR.')") 
×
663
       write (report_unit, fmt="('################# WARNING #######################')")
×
664
       write (report_unit, *) 
×
665

666
    case (ginitopt_alf)
667
       write (report_unit, fmt="('Initial conditions:')")
×
668
       write (report_unit, *) 
×
669
       write (report_unit, fmt="('################# WARNING #######################')")
×
670
       write (report_unit, fmt="('Ion dist fn proportional to v_parallel * sin(theta).')")
×
671
       write (report_unit, fmt="('THIS IS PROBABLY AN ERROR.')") 
×
672
       write (report_unit, fmt="('################# WARNING #######################')")
×
673
       write (report_unit, *) 
×
674

675
    case (ginitopt_zero)
676
       write (report_unit, fmt="('Initial conditions:')")
×
677
       write (report_unit, *) 
×
678
       write (report_unit, fmt="('################# WARNING #######################')")
×
679
       write (report_unit, fmt="('Distribution function = 0.')")
×
680
       write (report_unit, fmt="('THIS IS PROBABLY AN ERROR.')") 
×
681
       write (report_unit, fmt="('################# WARNING #######################')")
×
682
       write (report_unit, *) 
×
683

684
    case (ginitopt_test3)
685
       write (report_unit, fmt="('Initial conditions:')")
×
686
       write (report_unit, *) 
×
687
       write (report_unit, fmt="('################# WARNING #######################')")
×
688
       write (report_unit, fmt="('THIS IS PROBABLY AN ERROR.')") 
×
689
       write (report_unit, fmt="('################# WARNING #######################')")
×
690
       write (report_unit, *) 
×
691

692
    case (ginitopt_convect)
693
       write (report_unit, fmt="('Initial conditions:')")
×
694
       write (report_unit, *) 
×
695
       write (report_unit, fmt="('################# WARNING #######################')")
×
696
       write (report_unit, fmt="('THIS IS PROBABLY AN ERROR.')") 
×
697
       write (report_unit, fmt="('################# WARNING #######################')")
×
698
       write (report_unit, *) 
×
699

700
    case (ginitopt_restart_many)
701
       write (report_unit, fmt="('Initial conditions:')")
×
702
       write (report_unit, fmt="('Each PE restarts from its own NetCDF restart file.')") 
×
703

704
    case (ginitopt_restart_small)
705
       write (report_unit, fmt="('Initial conditions:')")
×
706
       write (report_unit, fmt="('Each PE restarts from its own NetCDF restart file.')") 
×
707
       write (report_unit, fmt="('with amplitudes scaled by factor of scale = ',f10.4)") scale
×
708
       write (report_unit, fmt="('Noise added with amplitude = ',f10.4)") phiinit
×
709

710
    case (ginitopt_continue)
711
       write (report_unit, fmt="('Initial conditions:')")
×
712
       write (report_unit, *) 
×
713
       write (report_unit, fmt="('################# WARNING #######################')")
×
714
       write (report_unit, fmt="('THIS IS PROBABLY AN ERROR.')") 
×
715
       write (report_unit, fmt="('################# WARNING #######################')")
×
716
       write (report_unit, *) 
×
717

718
    case (ginitopt_cgyro)
719
       write (report_unit, fmt="('Initial conditions:')")
×
720
       write (report_unit, fmt="('  Amplitude:        ',f10.4)") phiinit
×
721
       write (report_unit, fmt="('Constant amplitude for ky!=0')")
×
722
       write (report_unit, fmt="('Zero amplitude for ky=0')")
×
723

724
    case (ginitopt_random_sine)
725
       write (report_unit, fmt="('Initial conditions:')")
×
726
       write (report_unit, fmt="('  Amplitude:        ',f10.4)") phiinit
×
727
       write (report_unit, fmt="('  Zonal amplitude:  ',f10.4)") zf_init
×
728
       write (report_unit, fmt="('  Max mode:         ',I0)") max_mode
×
729
       write (report_unit, fmt="(' Random sum of sine waves up to max_mode mode number')")
×
730

731
    case (ginitopt_constant)
732
       write (report_unit, fmt="('Initial conditions:')")
×
733
       write (report_unit, fmt="('  Amplitude:        ',f10.4)") phiinit
×
734
       write (report_unit, fmt="('  Zonal amplitude:  ',f10.4)") zf_init
×
735
       write (report_unit, fmt="(' Constant value')")
×
736
    end select
737

738
    if (ginitopt_switch == ginitopt_restart_many) then
×
739
       if (delt_option_switch == delt_option_auto) then
×
740
          write (report_unit, *) 
×
741
          write (report_unit, fmt="('This run is a continuation of a previous run.')") 
×
742
          write (report_unit, fmt="('The time step at the beginning of this run')") 
×
743
          write (report_unit, fmt="('will be taken from the end of the previous run.')") 
×
744
       else
745
          write (report_unit, *) 
×
746
          write (report_unit, fmt="('################# WARNING #######################')")
×
747
          write (report_unit, fmt="('This run is a continuation of a previous run.')") 
×
748
          write (report_unit, fmt="('The time step is being set by hand.')") 
×
749
          write (report_unit, fmt="('THIS IS PROBABLY AN ERROR.')") 
×
750
          write (report_unit, fmt="('You probably want to set delt_option to be check_restart in the knobs namelist.')") 
×
751
          write (report_unit, fmt="('################# WARNING #######################')")
×
752
          write (report_unit, *) 
×
753
       end if
754
    end if
755

756
    if (delt_option_switch == delt_option_auto) then
×
757
       if (ginitopt_switch /= ginitopt_restart_many) then
×
758
          write (report_unit, *) 
×
759
          write (report_unit, fmt="('################# WARNING #######################')")
×
760
          write (report_unit, fmt="('This is not a normal continuation run.')") 
×
761
          write (report_unit, fmt="('You probably want to set delt_option to be default in the knobs namelist.')") 
×
762
          write (report_unit, fmt="('THIS IS PROBABLY AN ERROR.')") 
×
763
          write (report_unit, fmt="('################# WARNING #######################')")
×
764
          write (report_unit, *) 
×
765
       end if
766
    end if
767
  end subroutine check_init_g
×
768

769
  !> Join restart_dir to restart_file, accounting for potential existence
770
  !> of path in restart_file already.
771
  subroutine add_restart_dir_to_file(restart_dir, restart_file)
12✔
772
    character(len = *), intent(in out) :: restart_dir, restart_file
773
    integer :: ind_slash
774
    ! prepend restart_dir to restart_file
775
    ! append trailing slash if not exists
776
    if (restart_dir(len_trim(restart_dir):) /= "/") restart_dir = trim(restart_dir)//"/"
12✔
777
    !Determine if restart file contains "/" if so split on this point to give DIR//FILE
778
    !so restart files are created in DIR//restart_dir//FILE
779
    ind_slash = index(restart_file, "/", .true.)
12✔
780
    if (ind_slash == 0) then !No slash present
12✔
781
       restart_file = trim(restart_dir) // trim(restart_file)
12✔
782
    else !Slash present
783
       restart_file = trim(restart_file(1:ind_slash)) // trim(restart_dir) // trim(restart_file(ind_slash+1:))
×
784
    end if
785
  end subroutine add_restart_dir_to_file
12✔
786

787
  !> FIXME : Add documentation
788
  subroutine init_init_g(init_g_config_in)
12✔
789
    use gs2_save, only: set_restart_file, proc_to_save_fields
790
    use mp, only: nproc
791
    implicit none
792
    type(init_g_config_type), intent(in), optional :: init_g_config_in    
793

794
    if (initialized) return
12✔
795
    initialized = .true.
12✔
796

797
    call read_parameters(init_g_config_in)
12✔
798
    call add_restart_dir_to_file(restart_dir, restart_file)
12✔
799
    call set_restart_file (restart_file)
12✔
800
    if (proc_to_save_fields >= 0) proc_to_save_fields = mod(proc_to_save_fields, nproc)
12✔
801
  end subroutine init_init_g
802

803
  !> FIXME : Add documentation  
804
  subroutine ginit (restarted, override_ginitopt_switch)
×
805
    use gs2_save, only: read_t0_from_restart_file
806
    use species, only: has_hybrid_electron_species, spec
807
    use mp, only: proc0
808
    use optionals, only: get_option_with_default
809
    implicit none
810
    logical, intent (out) :: restarted
811
    integer, intent(in), optional :: override_ginitopt_switch
812
    logical, save :: have_warned_about_hybrid = .false.
813
    integer :: ginitopt_actual
814

815
    ginitopt_actual = get_option_with_default(override_ginitopt_switch, ginitopt_switch)
×
816

817
    restarted = .false.
×
818
    select case (ginitopt_actual)
×
819
    case (ginitopt_default)
820
       call ginit_default(use_odd = .false.)
×
821
    case (ginitopt_default_odd)
822
       call ginit_default(use_odd = .true.)
×
823
    case (ginitopt_kz0)
824
       call ginit_kz0
×
825
    case (ginitopt_noise)
826
       call ginit_noise
×
827
    case (ginitopt_single_parallel_mode)
828
       call ginit_single_parallel_mode
×
829
    case (ginitopt_all_modes_equal)
830
       call ginit_all_modes_equal
×
831
    case (ginitopt_kpar)
832
       call ginit_kpar
×
833
    case (ginitopt_gs)
834
       call ginit_gs
×
835
    case (ginitopt_nl)
836
       call ginit_nl
×
837
    case (ginitopt_nl2)
838
       call ginit_nl2
×
839
    case (ginitopt_nl3)
840
       call ginit_nl3(include_apar = .false.)
×
841
    case (ginitopt_nl3r)
842
       call ginit_nl3(include_apar = .true.)
×
843
    case (ginitopt_harris)
844
       call ginit_harris
×
845
    case (ginitopt_nl4)
846
       ! in an old version, this line was commented out.  Thus, to recover some old
847
       ! results, you might need to comment out this line and...
848
       !       t0 = tstart
849
       call ginit_nl4
×
850
       call read_t0_from_restart_file (tstart)
×
851
       ! this line:
852
       !       tstart = t0
853
       restarted = .true.
×
854
       scale = 1.
×
855
    case (ginitopt_nl5)
856
       call ginit_nl5
×
857
       restarted = .true.
×
858
       scale = 1.
×
859
    case (ginitopt_recon)
860
       call ginit_recon
×
861
       restarted = .true.
×
862
       scale = 1.
×
863
    case (ginitopt_nl6)
864
       call ginit_nl6
×
865
       restarted = .true.
×
866
       scale = 1.
×
867
    case (ginitopt_nl7)
868
       call ginit_nl7
×
869
    case (ginitopt_xi)
870
       call ginit_xi
×
871
    case (ginitopt_xi2)
872
       call ginit_xi2
×
873
    case (ginitopt_rh)
874
       call ginit_rh
×
875
    case (ginitopt_alf)
876
       call ginit_alf
×
877
    case (ginitopt_zero)
878
       call ginit_zero
×
879
    case (ginitopt_test3)
880
       call ginit_test3
×
881
    case (ginitopt_convect)
882
       call ginit_convect
×
883
    case (ginitopt_restart_many)
884
       call ginit_restart_many 
×
885
       call read_t0_from_restart_file (tstart)
×
886
       restarted = .true.
×
887
       scale = 1.
×
888
    case (ginitopt_restart_eig)
889
       call ginit_restart_eig 
×
890
       call read_t0_from_restart_file (tstart)
×
891
       restarted = .true.
×
892
       scale = 1.
×
893
    case (ginitopt_restart_small)
894
       call ginit_restart_small
×
895
       call read_t0_from_restart_file (tstart)
×
896
       restarted = .true.
×
897
       scale = 1.
×
898
    case (ginitopt_zonal_only)
899
       call ginit_restart_zonal_only
×
900
       call read_t0_from_restart_file (tstart)
×
901
       restarted = .true.
×
902
       scale = 1.
×
903
    case (ginitopt_no_zonal)
904
       call ginit_restart_no_zonal
×
905
       call read_t0_from_restart_file (tstart)
×
906
       restarted = .true.
×
907
       scale = 1.
×
908
    case (ginitopt_smallflat)
909
       call ginit_restart_smallflat
×
910
       call read_t0_from_restart_file (tstart)
×
911
       restarted = .true.
×
912
       scale = 1.
×
913
    case (ginitopt_continue)
914
       restarted = .true.
×
915
       scale = 1.
×
916
    case (ginitopt_recon3)
917
       call ginit_recon3
×
918
    case (ginitopt_ot)
919
       call ginit_ot
×
920
    case (ginitopt_stationary_mode)
921
       call ginit_stationary_mode
×
922
    case (ginitopt_cgyro)
923
       call ginit_cgyro
×
924
    case (ginitopt_random_sine)
925
       call ginit_random_sine
×
926
    case (ginitopt_constant)
927
       call ginit_constant
×
928
    end select
929

930
    ! If the initial condition is the nonadiabatic dfn then
931
    ! ensure we've actually set `gnew` correctly.
932
    ! We avoid doing this if we're restarting as currently we assume
933
    ! that the restart files always contain our evolved gnew, rather
934
    ! than the nonadiabatic dfn.
935
    if (initial_condition_is_nonadiabatic_dfn .and. .not. restarted) then
×
936
       call set_gnew_from_nonadiabatic_dfn
×
937
    else
938
       ! If not restarting and have a hybrid electron species then
939
       ! issue a warning (once only) as recommend initialising the
940
       ! non-adiabatic dfn directly in this situation as this respects
941
       ! the hybrid electron h = 0 condition.
942
       if ((.not. restarted) .and. has_hybrid_electron_species(spec) &
943
            .and. (.not. have_warned_about_hybrid) .and. proc0) then
×
944
          have_warned_about_hybrid = .true.
×
945
          write(*,'("Warning : Running with a hybrid electron species but initial_condition_is_nonadiabatic_dfn is false.")')
×
946
       end if
947
    end if
948
    
949
  end subroutine ginit
×
950

951
  !> Take the existing gnew value and, assuming it is the nonadiabatic dfn,
952
  !> calculate the consistent potentials to set the true gnew value.
953
  subroutine set_gnew_from_nonadiabatic_dfn
×
954
    use dist_fn_arrays, only: gnew, g, g_adjust, to_g_gs2
955
    use dist_fn, only: calculate_potentials_from_nonadiabatic_dfn
956
    use species, only: spec, has_hybrid_electron_species
957
    use le_grids, only: is_passing_hybrid_electron
958
    use gs2_layouts, only: g_lo, ik_idx, il_idx, is_idx
959
    use fields_arrays, only: phi, apar, bpar, phinew, aparnew, bparnew
960
    use array_utils, only: copy
961
    implicit none
962
    integer :: iglo, ik, il, is
963

964
    ! Respect passing hybrid electrons h=0
965
    if (has_hybrid_electron_species(spec)) then
×
966
       do iglo = g_lo%llim_proc, g_lo%ulim_proc
×
967
          is = is_idx(g_lo, iglo)
×
968
          ik = ik_idx(g_lo, iglo)
×
969
          il = il_idx(g_lo, iglo)
×
970
          if (is_passing_hybrid_electron(is, ik, il)) gnew(:,:,iglo) = 0.0
×
971
       end do
972
    end if
973

974
    ! Calculate the consistent potentials
975
    call calculate_potentials_from_nonadiabatic_dfn(gnew, phi, apar, bpar)
×
976

977
    ! Adjust the nonadiabatic dfn to give the actual gnew we evolve
978
    call g_adjust(gnew, phi, bpar, direction = to_g_gs2)
×
979

980
    ! Ensure both timesteps are set correctly
981
    call copy(gnew, g)
×
982
    call copy(phi, phinew)
×
983
    call copy(apar, aparnew)
×
984
    call copy(bpar, bparnew)
×
985
  end subroutine set_gnew_from_nonadiabatic_dfn
×
986

987
  !> Set the smart defaults for the init_g_config_type instance
988
  subroutine set_smart_defaults_local(self)
12✔
989
    use file_utils, only: run_name
990
    implicit none
991
    class(init_g_config_type), intent(in out) :: self
992
    if (self%is_initialised()) return
12✔
993
    if (.not. self%override_restart_file) self%restart_file = trim(run_name)//".nc"
12✔
994
  end subroutine set_smart_defaults_local
995

996
  !> FIXME : Add documentation
997
  subroutine read_parameters(init_g_config_in)
12✔
998
    use file_utils, only: error_unit
999
    use text_options, only: text_option, get_option_value
1000
    use gs2_save, only: read_many, include_explicit_source_in_restart, proc_to_save_fields
1001
    use mp, only: job
1002
    implicit none
1003
    type(init_g_config_type), intent(in), optional :: init_g_config_in
1004

1005
    type (text_option), dimension (*), parameter :: ginitopts = &
1006
         [ text_option('default', ginitopt_default), &
1007
            text_option('default_odd', ginitopt_default_odd), &
1008
            text_option('noise', ginitopt_noise), &
1009
            text_option('xi', ginitopt_xi), &
1010
            text_option('xi2', ginitopt_xi2), &
1011
            text_option('zero', ginitopt_zero), &
1012
            text_option('test3', ginitopt_test3), &
1013
            text_option('convect', ginitopt_convect), &
1014
            text_option('rh', ginitopt_rh), &
1015
            text_option('restart', ginitopt_restart_many), &
1016
            text_option('many', ginitopt_restart_many), &
1017
            text_option('small', ginitopt_restart_small), &
1018
            text_option('file', ginitopt_restart_many), &
1019
            text_option('cont', ginitopt_continue), &
1020
            text_option('kz0', ginitopt_kz0), &
1021
            text_option('nl', ginitopt_nl), &
1022
            text_option('nl2', ginitopt_nl2), &
1023
            text_option('nl3', ginitopt_nl3), &
1024
            text_option('nl3r', ginitopt_nl3r), &
1025
            text_option('nl4', ginitopt_nl4), &
1026
            text_option('nl5', ginitopt_nl5), &
1027
            text_option('nl6', ginitopt_nl6), &
1028
            text_option('nl7', ginitopt_nl7), &
1029
            text_option('alf', ginitopt_alf), &
1030
            text_option('gs', ginitopt_gs), &
1031
            text_option('kpar', ginitopt_kpar), &
1032
            text_option('smallflat', ginitopt_smallflat), &
1033
            text_option('harris', ginitopt_harris), &
1034
            text_option('recon', ginitopt_recon), &
1035
            text_option('recon3', ginitopt_recon3), &
1036
            text_option('ot', ginitopt_ot), &
1037
            text_option('zonal_only', ginitopt_zonal_only), &
1038
            text_option('no_zonal', ginitopt_no_zonal), &
1039
            text_option('single_parallel_mode', ginitopt_single_parallel_mode), &
1040
            text_option('all_modes_equal', ginitopt_all_modes_equal), &
1041
            text_option('eig_restart', ginitopt_restart_eig), &
1042
            text_option('stationary_mode', ginitopt_stationary_mode), &
1043
            text_option('cgyro', ginitopt_cgyro), &
1044
            text_option('random_sine', ginitopt_random_sine), &
1045
            text_option('constant', ginitopt_constant) &
1046
            ]
1047
    character(20) :: ginit_option
1048

1049
    if (present(init_g_config_in)) init_g_config = init_g_config_in
12✔
1050
    call init_g_config%init(name = 'init_g_knobs', requires_index = .false.)
12✔
1051

1052
    ! Copy out internal values into module level parameters
1053
    associate(self => init_g_config)
1054
#include "init_g_copy_out_auto_gen.inc"
1055
    end associate
1056

1057
    ! MAB - allows for ensemble averaging of multiple flux tube calculations
1058
    ! job=0 if not doing multiple flux tube calculations, so phiinit unaffected
1059
    phiinit = phiinit * (job * phifrac + 1.0)
12✔
1060

1061
    call get_option_value &
1062
         (ginit_option, ginitopts, ginitopt_switch, &
1063
         error_unit(), "ginit_option in ginit_knobs",.true.)
12✔
1064
  end subroutine read_parameters
12✔
1065

1066
  !> Set initial condition to gaussian in \(\theta\)
1067
  !>
1068
  !> Controlled by:
1069
  !> - Amplitude: [[init_g_knobs:phiinit]]
1070
  !> - Width in \(\theta\): [[init_g_knobs:width0]]
1071
  !> - Parity: even about \(\theta_0\) unless [[init_g_knobs:chop_side]] is true
1072
  subroutine ginit_default(use_odd)
×
1073
    use species, only: spec
1074
    use theta_grid, only: ntgrid, theta
1075
    use kt_grids, only: naky, ntheta0, theta0, aky, enforce_reality
1076
    use le_grids, only: forbid
1077
    use dist_fn_arrays, only: g, gnew
1078
    use gs2_layouts, only: g_lo, ik_idx, it_idx, il_idx, is_idx
1079
    use array_utils, only: copy
1080
    use warning_helpers, only: is_zero
1081
    implicit none
1082
    logical, intent(in) :: use_odd
1083
    complex, dimension (-ntgrid:ntgrid,ntheta0,naky) :: phi
×
1084
    integer :: iglo, ig, ik, it, il, is
1085

1086
    do ik = 1, naky
×
1087
       do it = 1, ntheta0
×
1088
          do ig = -ntgrid, ntgrid
×
1089
             phi(ig, it, ik) = exp(-((theta(ig)-theta0(it, ik))/width0)**2) * cmplx(1.0,1.0)
×
1090
          end do
1091
       end do
1092
    end do
1093
    if (use_odd) then
×
1094
       do ik = 1, naky
×
1095
          do it = 1, ntheta0
×
1096
             do ig = -ntgrid, ntgrid
×
1097
                phi(ig, it, ik) = phi(ig, it, ik) * sin((theta(ig)-theta0(it, ik))/width0)
×
1098
             end do
1099
          end do
1100
       end do
1101
    end if
1102

1103
    call do_chop_side(phi)
×
1104
    
1105
    if (enforce_reality) then
×
1106
       phi(:, 1, 1) = 0.0
×
1107
       if (naky > 1 .and. is_zero(aky(1))) phi(:, :, 1) = 0.0
×
1108
       call apply_reality(phi)
×
1109
    end if
1110

1111
    do iglo = g_lo%llim_proc, g_lo%ulim_proc
×
1112
       ik = ik_idx(g_lo, iglo)
×
1113
       it = it_idx(g_lo, iglo)
×
1114
       il = il_idx(g_lo, iglo)
×
1115
       is = is_idx(g_lo, iglo)
×
1116
       g(:, 1, iglo) = phi(:, it, ik) * spec(is)%z * phiinit
×
1117
       where (forbid(:, il)) g(:, 1, iglo) = 0.0
×
1118
       g(:, 2, iglo) = g(:, 1, iglo)
×
1119
    end do
1120
    call copy(g, gnew)
×
1121
  end subroutine ginit_default
×
1122

1123
  !> Initialise with only the kparallel = 0 mode. 
1124
  subroutine ginit_kz0
×
1125
    use species, only: spec
1126
    use theta_grid, only: ntgrid 
1127
    use kt_grids, only: naky, ntheta0, aky, enforce_reality
1128
    use le_grids, only: forbid
1129
    use dist_fn_arrays, only: g, gnew, vpa, vperp2
1130
    use gs2_layouts, only: g_lo, ik_idx, it_idx, il_idx, is_idx
1131
    use array_utils, only: copy
1132
    use warning_helpers, only: is_zero
1133
    implicit none
1134
    complex, dimension (-ntgrid:ntgrid,ntheta0,naky) :: phi
×
1135
    integer :: iglo, ik, it, il, is
1136

1137
    phi = cmplx(refac,imfac)
×
1138
    call do_chop_side(phi)
×
1139
    
1140
    if (enforce_reality) then
×
1141
       phi(:,1,1) = 0.0
×
1142
       if (naky > 1 .and. is_zero(aky(1))) phi(:,:,1) = 0.0
×
1143
       call apply_reality(phi)
×
1144
    end if
1145

1146
    do iglo = g_lo%llim_proc, g_lo%ulim_proc
×
1147
       ik = ik_idx(g_lo,iglo)
×
1148
       it = it_idx(g_lo,iglo)
×
1149
       il = il_idx(g_lo,iglo)
×
1150
       is = is_idx(g_lo,iglo)
×
1151
       g(:,1,iglo) = -phi(:,it,ik)*spec(is)%z*phiinit*(den0 + sqrt(2.)*upar0*vpa(:,1,iglo) + tpar0*(vpa(:,1,iglo)**2-0.5) + tperp0*(vperp2(:,iglo)-1.))
×
1152
       where (forbid(:,il)) g(:,1,iglo) = 0.0
×
1153
       g(:,2,iglo) = -phi(:,it,ik)*spec(is)%z*phiinit*(den0 + sqrt(2.)*upar0*vpa(:,2,iglo) + tpar0*(vpa(:,2,iglo)**2-0.5) + tperp0*(vperp2(:,iglo)-1.))
×
1154
    end do
1155
    call copy(g, gnew)
×
1156
  end subroutine ginit_kz0
×
1157

1158
  !> Initialise the distribution function with random noise. This is the
1159
  !> recommended initialisation option. Each different mode is given a random
1160
  !> amplitude between zero and one.
1161
  subroutine ginit_noise
×
1162
    use species, only: spec, tracer_species
1163
    use theta_grid, only: ntgrid 
1164
    use kt_grids, only: l_links, r_links, naky, ntheta0, aky, enforce_reality, akx, kperp2
1165
    use le_grids, only: forbid
1166
    use dist_fn_arrays, only: g, gnew
1167
    use gs2_layouts, only: g_lo, ik_idx, it_idx, il_idx, is_idx, proc_id
1168
    use dist_fn, only: pass_right, init_pass_ends, has_linked_boundary
1169
    use redistribute, only: fill, delete_redist
1170
    use ran, only: ranf
1171
    use constant_random, only: init_constant_random
1172
    use constant_random, only: finish_constant_random
1173
    use constant_random, only: constant_ranf=>ranf
1174
    use array_utils, only: copy, zero_array
1175
    use constants, only: twopi
1176
    use warning_helpers, only: is_zero
1177
    implicit none
1178
    complex, dimension (-ntgrid:ntgrid,ntheta0,naky) :: phi, phit
×
1179
    real :: a, b, spec_pow
1180
    integer :: iglo, ig, ik, it, il, is, nn
1181
    logical :: linked_bc
1182

1183
    linked_bc = has_linked_boundary()
×
1184

1185
    !CMR: need to document tracer phit parameter   ;-)
1186
    call zero_array(phit)
×
1187
    do it=2,ntheta0/2+1
×
1188
       nn = it-1
×
1189
       ! extra factor of 4 to reduce the high k wiggles for now
1190
       phit (:, it, 1) = (-1)**nn*exp(-8.*(real(nn)/ntheta0)**2)
×
1191
    end do
1192
    
1193
    ! keep old (it, ik) loop order to get old results exactly: 
1194

1195
    !Fill phi with random (complex) numbers between -0.5 and 0.5
1196
    if (constant_random_flag) call init_constant_random
×
1197
    do it = 1, ntheta0
×
1198
       do ik = 1, naky
×
1199
          do ig = -ntgrid, ntgrid
×
1200
             if (constant_random_flag) then
×
1201
                a = constant_ranf()-0.5
×
1202
                b = constant_ranf()-0.5
×
1203
             else
1204
                a = ranf()-0.5
×
1205
                b = ranf()-0.5
×
1206
             end if
1207
             if (init_spec_pow > 0.) then
×
1208
                spec_pow = 1./sqrt(1.+kperp2(ig,it,ik)**(0.5*init_spec_pow))
×
1209
                phi(ig,it,ik) = spec_pow*exp(cmplx(0.,twopi*a))
×
1210
             else
1211
                phi(ig,it,ik) = cmplx(a,b)
×
1212
             end if
1213
          end do
1214
          !CMR,28/1/13:
1215
          ! clean_init debrutalises influence of chop_side on phi with linked bc
1216
          if (chop_side) then
×
1217
             if (clean_init .and. linked_bc) then
×
1218
                if (left) then
×
1219
                   !Does this tube have more links to the right than the left?
1220
                   !If so then it's on the left so set to zero
1221
                   if (l_links(it, ik) < r_links(it, ik)) then
×
1222
                      phi(:,it,ik) = 0.0 
×
1223
                      !This tube is in the middle so only set the left half to 0
1224
                   else if (l_links(it, ik) == r_links(it, ik)) then
×
1225
                      phi(:-1,it,ik) = 0.0
×
1226
                   endif
1227
                else
1228
                   !Does this tube have more links to the left than the right?
1229
                   !If so then it's on the right so set to zero
1230
                   if (r_links(it, ik) < l_links(it, ik)) then
×
1231
                      phi(:,it,ik) = 0.0
×
1232
                      !This tube is in the middle so only set the right half to 0
1233
                   else if (l_links(it, ik) == r_links(it, ik)) then
×
1234
                      phi(1:,it,ik) = 0.0
×
1235
                   endif
1236
                end if
1237
             else
1238
                call do_chop_side(phi(:, it, ik))
×
1239
             end if
1240
          end if
1241
       end do
1242
    end do
1243
    if (constant_random_flag) call finish_constant_random
×
1244

1245
    !Wipe out all but one kx if requested
1246
    if (ikx_init  > 0) call single_initial_kx(phi)
×
1247
    
1248
    !Sort out the zonal/self-periodic modes
1249
    if (naky >= 1 .and. is_zero(aky(1))) then
×
1250
       !Apply scaling factor
1251
       phi(:,:,1) = phi(:,:,1)*zf_init
×
1252
       
1253
       !Set ky=kx=0.0 mode to zero in amplitude
1254
       if (is_zero(akx(1))) phi(:,1,1) = 0.0
×
1255
       
1256
       !CMR, 25/1/13: clean_init forces periodic zonal flows
1257
       if (clean_init .and. linked_bc) then
×
1258
          phi(ntgrid,:,1)=phi(-ntgrid,:,1)
×
1259
          phit(ntgrid,:,1)=phit(-ntgrid,:,1)
×
1260
       end if
1261
    end if
1262

1263
    if (enforce_reality) then
×
1264
       call apply_reality(phi)
×
1265
       call apply_reality(phit)
×
1266
    end if
1267

1268
    !Now set g using data in phi
1269
    do iglo = g_lo%llim_proc, g_lo%ulim_proc
×
1270
       ik = ik_idx(g_lo,iglo)
×
1271
       it = it_idx(g_lo,iglo)
×
1272
       il = il_idx(g_lo,iglo)
×
1273
       is = is_idx(g_lo,iglo)
×
1274

1275
       !Handle tracer_species 
1276
       if (spec(is)%type == tracer_species) then          
×
1277
          g(:,1,iglo) =-phit(:,it,ik)*spec(is)%z*phiinit
×
1278
       else
1279
          g(:,1,iglo) = -phi(:,it,ik)*spec(is)%z*phiinit
×
1280
       end if
1281

1282
       !Make sure there's no g in the forbidden regions
1283
       where (forbid(:,il)) g(:,1,iglo) = 0.0
×
1284
     
1285
       !Set incoming and outgoing boundary conditions
1286
       if ( clean_init .and. linked_bc .and. ik > 1) then
×
1287
          !CMR: clean_init sets g=0 for incoming particles, 
1288
          !                         and outgoing particles
1289
          !                      as initial condition sets g(:,1,:) = g(:,2,:) )
1290
          !If no links to the left then we're at the left boundary
1291
          if ( l_links(it, ik) == 0 ) g(-ntgrid,1,iglo)=0.0
×
1292
          !If no links to the right then we're at the right boundary
1293
          if ( r_links(it, ik) == 0 ) g(ntgrid,1,iglo)=0.0
×
1294
       endif
1295
    end do
1296

1297
    
1298
    !If clean_init is set and there are any links/connections then make sure repeated points are consistent
1299
    if ( clean_init .and. linked_bc .and. sum(r_links+l_links) > 0 ) then
×
1300
       !   
1301
       !CMR, 23/1/13:  
1302
       !  clean_init: ensure continuity in || direction with linked bcs
1303
       !  set up redistribute type pass_right 
1304
       !  this passes g(ntgrid,1,iglo) to g(-ntgrid,1,iglo_r) on right neighbour 
1305

1306
       !Initialise communications object !NOTE This should be moved to dist_fn in future
1307
       call init_pass_ends(pass_right,'r',1,'c')
×
1308

1309
       !Pass right boundaries (ntgrid) of g to linked left boundaries (-ntgrid) of g
1310
       call fill(pass_right,g,g)
×
1311

1312
       !Deallocate comm object as not used anywhere else !NOTE This will need removing if/when initialisation moved to dist_fn
1313
       call delete_redist(pass_right)
×
1314

1315
       !Make leftwards and rightwards particles the same
1316
       g(:,2,:)=g(:,1,:)
×
1317

1318
       !Set gnew to be the "fixed" data
1319
       call copy(g, gnew)
×
1320
    else 
1321
! finally initialise isign=2
1322
       g(:,2,:) = g(:,1,:)
×
1323
       call copy(g, gnew)
×
1324
    endif
1325

1326
  end subroutine ginit_noise
×
1327

1328
  !> Initialise only with a single parallel mode \(k_\Vert\) specified by either
1329
  !> [[init_g_knobs:ikpar_init]] for periodic boundary conditions or
1330
  !> [[init_g_knobs:kpar_init]] for linked boundary conditions. Only makes sense
1331
  !> for linear calculations.
1332
  subroutine ginit_single_parallel_mode
×
1333
    use species, only: spec, tracer_species
1334
    use theta_grid, only: ntgrid, is_effectively_zero_shear, theta, shat
1335
    use kt_grids, only: naky, ntheta0, aky, enforce_reality
1336
    use le_grids, only: forbid
1337
    use mp, only: mp_abort
1338
    use dist_fn_arrays, only: g, gnew
1339
    use gs2_layouts, only: g_lo, ik_idx, it_idx, il_idx, is_idx
1340
    use array_utils, only: copy, zero_array
1341
    use warning_helpers, only: is_zero
1342
    implicit none
1343
    complex, dimension (-ntgrid:ntgrid,ntheta0,naky) :: phi, phit
×
1344
    real :: a, b
1345
    integer :: iglo, ig, ik, it, il, is, nn
1346

1347
    call zero_array(phit)
×
1348
    do it=2,ntheta0/2+1
×
1349
       nn = it-1
×
1350
       ! extra factor of 4 to reduce the high k wiggles for now
1351
       phit (:, it, 1) = (-1)**nn*exp(-8.*(real(nn)/ntheta0)**2)
×
1352
    end do
1353

1354
    if (is_effectively_zero_shear() .or. is_zero(shat)) then
×
1355
      if (ikpar_init+1 > ntgrid) then
×
1356
        call mp_abort("Error: this value of k_parallel is too large. Increase ntheta or decrease ikpar_init.")
×
1357
      end if
1358
      kpar_init = ikpar_init
×
1359
    end if
1360

1361
    do it = 1, ntheta0
×
1362
       do ik = 1, naky
×
1363
          do ig = -ntgrid, ntgrid
×
1364
             !Set the field to cos(kpar_init*theta), where we remember
1365
             !that the gridpoints are not necessarily evenly spaced in
1366
             !the parallel direction, so we use theta(ig).  reality
1367
             !for ky=0 means we must use -kpar for kx < 0
1368
             a = cos(kpar_init * theta(ig))
×
1369
             b = sin(kpar_init * theta(ig))
×
1370
             phi(ig,it,ik) = cmplx(a,b)
×
1371
          end do
1372
       end do
1373
    end do
1374

1375
    call do_chop_side(phi)
×
1376
    if (naky > 1 .and. is_zero(aky(1))) phi(:,:,1) = phi(:,:,1) * zf_init
×
1377
    if (ikx_init  > 0) call single_initial_kx(phi)
×
1378

1379
    if (enforce_reality) then
×
1380
       call apply_reality(phi)
×
1381
       call apply_reality(phit)
×
1382
    end if
1383
       
1384
    do iglo = g_lo%llim_proc, g_lo%ulim_proc
×
1385
       ik = ik_idx(g_lo,iglo)
×
1386
       it = it_idx(g_lo,iglo)
×
1387
       il = il_idx(g_lo,iglo)
×
1388
       is = is_idx(g_lo,iglo)
×
1389
       if (spec(is)%type == tracer_species) then          
×
1390
          g(:,1,iglo) =-phit(:,it,ik)*spec(is)%z*phiinit
×
1391
       else
1392
          g(:,1,iglo) = -phi(:,it,ik)*spec(is)%z*phiinit
×
1393
       end if
1394
       where (forbid(:,il)) g(:,1,iglo) = 0.0
×
1395
       g(:,2,iglo) = g(:,1,iglo)
×
1396
    end do
1397
    call copy(g, gnew)
×
1398
  end subroutine ginit_single_parallel_mode
×
1399

1400
  !> Initialize with every parallel and perpendicular mode having equal amplitude. 
1401
  !! Only makes sense in a linear calculation. k_parallel is specified with kpar_init 
1402
  !! or with ikpar_init when periodic boundary conditions are used. EGH 
1403
  subroutine ginit_all_modes_equal
×
1404
    use species, only: spec, tracer_species
1405
    use theta_grid, only: ntgrid, theta, ntheta 
1406
    use kt_grids, only: naky, ntheta0, enforce_reality
1407
    use le_grids, only: forbid
1408
    use dist_fn_arrays, only: g, gnew
1409
    use gs2_layouts, only: g_lo, ik_idx, it_idx, il_idx, is_idx
1410
    use array_utils, only: copy, zero_array
1411
    use warning_helpers, only: is_zero
1412
    implicit none
1413
    complex, dimension (-ntgrid:ntgrid,ntheta0,naky) :: phi, phit
×
1414
    real :: a, b
1415
    integer :: iglo, ig, ik, it, il, is, nn, ikpar
1416

1417
    call zero_array(phit)
×
1418
    do it=2,ntheta0/2+1
×
1419
       nn = it-1
×
1420
       ! extra factor of 4 to reduce the high k wiggles for now
1421
       phit (:, it, 1) = (-1)**nn*exp(-8.*(real(nn)/ntheta0)**2)
×
1422
    end do
1423

1424
    do it = 1, ntheta0
×
1425
       do ik = 1, naky
×
1426
          do ig = -ntgrid, ntgrid
×
1427
             ! Set the field to cos(kpar*theta) for all kpar, where we remember that the gridpoints are not necessarily evenly spaced in the parallel direction, so we use theta(ig)</doc>
1428
             a = 0.0
×
1429
             b = 0.0
×
1430
             do ikpar = 0, ntheta - 1
×
1431
                a = a + cos(ikpar * theta(ig))
×
1432
                ! we want to include the positive and negative wave numbers in
1433
                ! equal measure, which of course means a real sine wave.
1434
                b = 0.0 !b + cos(ikpar * theta(ig))
×
1435
             end do
1436
             phi(ig,it,ik) = cmplx(a,b)
×
1437
          end do
1438
       end do
1439
    end do
1440

1441
    call do_chop_side(phi)
×
1442
    if (ikx_init  > 0) call single_initial_kx(phi)
×
1443

1444
    if (enforce_reality) then
×
1445
       call apply_reality(phi)
×
1446
       call apply_reality(phit)
×
1447
    end if
1448
       
1449
    do iglo = g_lo%llim_proc, g_lo%ulim_proc
×
1450
       ik = ik_idx(g_lo,iglo)
×
1451
       it = it_idx(g_lo,iglo)
×
1452
       il = il_idx(g_lo,iglo)
×
1453
       is = is_idx(g_lo,iglo)
×
1454
       if (spec(is)%type == tracer_species) then          
×
1455
          g(:,1,iglo) =-phit(:,it,ik)*spec(is)%z*phiinit
×
1456
       else
1457
          g(:,1,iglo) = -phi(:,it,ik)*spec(is)%z*phiinit
×
1458
       end if
1459
       where (forbid(:,il)) g(:,1,iglo) = 0.0
×
1460
       g(:,2,iglo) = g(:,1,iglo)
×
1461
    end do
1462
    call copy(g, gnew)
×
1463
  end subroutine ginit_all_modes_equal
×
1464

1465
  !> "nl": Two \(k_\perp\) modes set to constant amplitude. Controlled by:
1466
  !>
1467
  !>  - Overall amplitude: [[init_g_knobs:phiinit]]
1468
  !>  - `ky` indices of modes: [[init_g_knobs:ikk]]
1469
  !>  - `kx` indices of modes: [[init_g_knobs:itt]]
1470
  !>  - Parity: even about \(\theta_0\) unless
1471
  !>    [[init_g_knobs:chop_side]] is true, in which case none
1472
  subroutine ginit_nl
×
1473
    use species, only: spec
1474
    use theta_grid, only: ntgrid 
1475
    use kt_grids, only: naky, ntheta0 
1476
    use le_grids, only: forbid, il_is_wfb
1477
    use dist_fn_arrays, only: g, gnew
1478
    use gs2_layouts, only: g_lo, ik_idx, it_idx, il_idx, is_idx
1479
    use array_utils, only: copy, zero_array
1480
    implicit none
1481
    complex, dimension (-ntgrid:ntgrid,ntheta0,naky) :: phi
×
1482
    integer :: iglo, ig, ik, it, il, is, j
1483
    call zero_array(phi)
×
1484
    do j = 1, 2
×
1485
       ik = ikk(j)
×
1486
       it = itt(j)
×
1487
       do ig = -ntgrid, ntgrid
×
1488
          phi(ig,it,ik) = cmplx(1.0, 0.0)!*sin(theta(ig))
×
1489
       end do
1490
       call do_chop_side(phi(:, it, ik))
×
1491
    end do
1492

1493
    call apply_reality(phi)
×
1494

1495
    ! charge dependence keeps initial Phi from being too small
1496
    do iglo = g_lo%llim_proc, g_lo%ulim_proc
×
1497
       ik = ik_idx(g_lo,iglo)
×
1498
       it = it_idx(g_lo,iglo)
×
1499
       il = il_idx(g_lo,iglo)
×
1500
       is = is_idx(g_lo,iglo)       
×
1501
       g(:,1,iglo) = -phi(:,it,ik)*phiinit*spec(is)%z
×
1502
       where (forbid(:,il)) g(:,1,iglo) = 0.0
×
1503
       g(:,2,iglo) = g(:,1,iglo)
×
1504
       if (il_is_wfb(il)) g(:,:,iglo) = 0.0
×
1505
    end do
1506
    call copy(g, gnew)
×
1507
  end subroutine ginit_nl
×
1508

1509
  !> "nl2": Two \(k_\perp\) modes proportional to \(1 + v_\Vert
1510
  !>     \sin(\theta)\). Controlled by:
1511
  !>
1512
  !>  - Overall amplitude: [[init_g_knobs:phiinit]]
1513
  !>  - `ky` indices of modes: [[init_g_knobs:ikk]]
1514
  !>  - `kx` indices of modes: [[init_g_knobs:itt]]
1515
  !>  - Parity: even about \(\theta_0\) unless
1516
  !>    [[init_g_knobs:chop_side]] is true, in which case none
1517
  subroutine ginit_nl2
×
1518
    use species, only: spec
1519
    use theta_grid, only: ntgrid, theta
1520
    use kt_grids, only: naky, ntheta0 
1521
    use le_grids, only: forbid, il_is_wfb
1522
    use dist_fn_arrays, only: g, gnew, vpa
1523
    use gs2_layouts, only: g_lo, ik_idx, it_idx, il_idx, is_idx
1524
    use array_utils, only: copy, zero_array
1525
    implicit none
1526
    complex, dimension (-ntgrid:ntgrid,ntheta0,naky) :: phi
×
1527
    integer :: iglo, ig, ik, it, il, is, j
1528
    call zero_array(phi)
×
1529
    do j = 1, 2
×
1530
       ik = ikk(j)
×
1531
       it = itt(j)
×
1532
       do ig = -ntgrid, ntgrid
×
1533
          phi(ig,it,ik) = cmplx(1.0, 0.0)!*sin(theta(ig))
×
1534
       end do
1535
       call do_chop_side(phi(:, it, ik))
×
1536
    end do
1537

1538
    call apply_reality(phi)
×
1539
    
1540
    ! charge dependence keeps initial Phi from being too small
1541
    do iglo = g_lo%llim_proc, g_lo%ulim_proc
×
1542
       ik = ik_idx(g_lo,iglo)
×
1543
       it = it_idx(g_lo,iglo)
×
1544
       il = il_idx(g_lo,iglo)
×
1545
       is = is_idx(g_lo,iglo)       
×
1546
       g(:,1,iglo) = -phi(:,it,ik)*phiinit*(1.+vpa(:,1,iglo)*sin(theta))*spec(is)%z
×
1547
       where (forbid(:,il)) g(:,1,iglo) = 0.0
×
1548
       g(:,2,iglo) = -phi(:,it,ik)*phiinit*(1.+vpa(:,2,iglo)*sin(theta))*spec(is)%z
×
1549
       if (il_is_wfb(il)) g(:,:,iglo) = 0.0
×
1550
    end do
1551
    call copy(g, gnew)
×
1552
  end subroutine ginit_nl2
×
1553

1554
  !> "nl3": Two \(k_\perp\) modes with a Gaussian envelope, and perturbation in
1555
  !> fields of form \(x_0 + x_1 \cos(\theta) + x_2 \cos(2 \theta)\), except for
1556
  !> parallel velocity which uses is 90 degrees out of phase and uses
1557
  !> \(\sin\). Density, parallel velocity, and perpendicular and parallel
1558
  !> temperatures can all be controlled independently. Controlled by:
1559
  !>
1560
  !>   - Overall amplitude: [[init_g_knobs:phiinit]]
1561
  !>   - Amplitude of real and imaginary parts of \(\phi\):
1562
  !>     [[init_g_knobs:refac]], [[init_g_knobs:imfac]]
1563
  !>   - Gaussian envelope width in \(\theta\): [[init_g_knobs:width0]]
1564
  !>   - `ky` indices of modes: [[init_g_knobs:ikk]]
1565
  !>   - `kx` indices of modes: [[init_g_knobs:itt]]
1566
  !>   - Parity: even about \(\theta_0\) unless
1567
  !>     [[init_g_knobs:chop_side]] is true, in which case none
1568
  !>   - Density perturbation: [[init_g_knobs:den0]],
1569
  !>     [[init_g_knobs:den1]], [[init_g_knobs:den2]]
1570
  !>   - Parallel velocity perturbation: [[init_g_knobs:upar0]],
1571
  !>     [[init_g_knobs:upar1]], [[init_g_knobs:upar2]]
1572
  !>   - Parallel temperature perturbation: [[init_g_knobs:tpar0]],
1573
  !>     [[init_g_knobs:tpar1]], [[init_g_knobs:tpar2]]
1574
  !>   - Perpendicular temperature perturbation: [[init_g_knobs:tperp0]],
1575
  !>     [[init_g_knobs:tperp1]], [[init_g_knobs:tperp2]]
1576
  subroutine ginit_nl3(include_apar)
×
1577
    use theta_grid, only: ntgrid, theta
1578
    use kt_grids, only: naky, ntheta0, theta0, enforce_reality
1579
    use dist_fn_arrays, only: g, gnew
1580
    use array_utils, only: copy, zero_array
1581
    use fields_arrays, only: apar, aparnew
1582
    implicit none
1583
    logical, intent(in) :: include_apar
1584
    complex, dimension (-ntgrid:ntgrid,ntheta0,naky) :: phi
×
1585
    integer :: ig, ik, it, j
1586
    call zero_array(phi)
×
1587
    do j = 1, 2
×
1588
       ik = ikk(j)
×
1589
       it = itt(j)
×
1590
       if (width0 > 0.) then
×
1591
          do ig = -ntgrid, ntgrid
×
1592
             phi(ig,it,ik) = exp(-((theta(ig)-theta0(it,ik))/width0)**2)*cmplx(refac, imfac)
×
1593
          end do
1594
       else
1595
          do ig = -ntgrid, ntgrid
×
1596
             phi(ig,it,ik) = cmplx(refac, imfac)
×
1597
          end do
1598
          if (include_apar) apar(:, it, ik) = apar0 * phi(:, it, ik)
×
1599
       end if
1600
       call do_chop_side(phi(:, it, ik))
×
1601
    end do
1602

1603
    if (enforce_reality .and. include_apar) call apply_reality(apar)
×
1604
    if (include_apar) call copy(apar, aparnew)
×
1605

1606
    call set_g_from_moment_facs(g, phiinit, phi, dfac_species_weight = .true., &
1607
         ufac_species_weight = .true., use_even = even, do_reality = enforce_reality)
×
1608
    call copy(g, gnew)
×
1609
  end subroutine ginit_nl3
×
1610

1611
  !> FIXME : Add documentation  
1612
  subroutine ginit_harris
×
1613
    use species, only: spec, has_electron_species
1614
    use kt_grids, only: naky, ntheta0, enforce_reality, nx
1615
    use le_grids, only: forbid
1616
    use dist_fn_arrays, only: g, gnew, vpa, aj0
1617
    use gs2_layouts, only: g_lo, ik_idx, it_idx, is_idx, il_idx
1618
    use constants, only: zi, pi
1619
    use array_utils, only: copy, zero_array
1620
    implicit none
1621
    complex, dimension (1,ntheta0,naky) :: phi
×
1622
    integer :: iglo, ik, it, il, is, j, j1
1623
    real, dimension(nx) :: lx_pr, a_pr
×
1624
    complex,dimension(nx) :: ff_pr
×
1625
    real:: L, dx_pr
1626
    !
1627
    ! Specifying function on x grid, with nx points.  Transforming to kx grid, with
1628
    ! nkx < nx points.  Result is function that will be used for initial condition.
1629
    ! But Fourier transform is the same if you just use nkx points in the first
1630
    ! place, right?
1631
    !
1632

1633
    ! Can specify x0 along with y0; no need to use this construction, although it is okay.
1634
    L=2.*pi*k0
×
1635

1636
    ! nx is available from kt_grids:
1637
    dx_pr=L/real(nx)
×
1638

1639
    do j = 1, nx
×
1640
       lx_pr(j)=dx_pr*real(j-1)
×
1641
    end do
1642

1643
    do j = 1,nx
×
1644
       a_pr(j)=1./cosh((lx_pr(j)-L/4.)/width0)- &
×
1645
         1./cosh((lx_pr(j)-3.*L/4.)/width0)
×
1646
    end do
1647

1648
    a_pr=a_pr/real(nx)
×
1649

1650
    do j = 1,nx
×
1651
       ff_pr(j) = 0.
×
1652
       do j1 = 1,nx
×
1653
          ff_pr(j)=ff_pr(j)+a_pr(j1)*exp(-zi*2.*pi*real(j-1)*real(j1-1)/real(nx))
×
1654
       end do
1655
    end do
1656

1657
    call zero_array(phi)
×
1658

1659
    ! Dealiasing here:
1660
    do j = 1, ntheta0/2-1
×
1661
       phi(1,j,1) = ff_pr(j)
×
1662
    end do
1663

1664
    ! Note: if the j=1 coefficient is non-zero, it might be a problem, because this
1665
    ! coefficient is never used.
1666
    do j = ntheta0/2, ntheta0
×
1667
       phi(1,j,1) = ff_pr(nx-ntheta0+j)
×
1668
    end do
1669

1670
    if (enforce_reality) call apply_reality(phi)
×
1671
    
1672
    call zero_array(g)
×
1673
    do iglo = g_lo%llim_proc, g_lo%ulim_proc
×
1674
       ik = ik_idx(g_lo,iglo)
×
1675
       it = it_idx(g_lo,iglo) 
×
1676
       il = il_idx(g_lo,iglo) 
×
1677
       is = is_idx(g_lo,iglo)       
×
1678
    
1679
       ! ions, kx/=0:
1680
       if ((is==1) .and.(.not.(it==1))) then
×
1681
       
1682
          g(:,1,iglo) =  2.* vpa(:,1,iglo)*spec(is)%u0 * phi(1,it,ik)/aj0(:,iglo)
×
1683
          g(:,2,iglo) =  2.* vpa(:,2,iglo)*spec(is)%u0 * phi(1,it,ik)/aj0(:,iglo)
×
1684

1685
          where (forbid(:,il)) g(:,1,iglo) = 0.0
×
1686
          where (forbid(:,il)) g(:,2,iglo) = 0.0
×
1687
          
1688
       end if
1689
    end do
1690
    call copy(g, gnew)
×
1691
  end subroutine ginit_harris
×
1692

1693
  !> FIXME : Add documentation  
1694
  subroutine ginit_recon
×
1695
    use theta_grid, only: ntgrid
1696
    use kt_grids, only: naky, ntheta0, enforce_reality
1697
    use gs2_save, only: gs2_restore
1698
    use dist_fn_arrays, only: g, gnew
1699
    use fields_arrays, only: phi, apar, bpar, phinew, aparnew, bparnew
1700
    use gs2_layouts, only: g_lo, ik_idx
1701
    use run_parameters, only: has_phi, has_apar, has_bpar
1702
    use array_utils, only: copy, zero_array
1703
    implicit none
1704
    complex, dimension (-ntgrid:ntgrid,ntheta0,naky) :: phiz
×
1705
    integer :: iglo, ig, ik, it, j
1706
    
1707
    call gs2_restore (g, scale, has_phi, has_apar, has_bpar)
×
1708

1709
    do iglo = g_lo%llim_proc, g_lo%ulim_proc
×
1710
       ik = ik_idx(g_lo,iglo)
×
1711
       if (ik == 1) cycle
×
1712
       g (:, :, iglo) = 0.
×
1713
    end do
1714

1715
    phinew(:,:,2:naky) = 0.
×
1716
    aparnew(:,:,2:naky) = 0.
×
1717
    bparnew(:,:,2:naky) = 0.
×
1718
    phi(:,:,2:naky) = 0.
×
1719
    apar(:,:,2:naky) = 0.
×
1720
    bpar(:,:,2:naky) = 0.
×
1721

1722
    call zero_array(phiz)
×
1723
    do j = 1, 2
×
1724
       ik = ikk(j)
×
1725
       it = itt(j)
×
1726
       do ig = -ntgrid, ntgrid
×
1727
          phiz(ig,it,ik) = cmplx(refac, imfac)
×
1728
       end do
1729
    end do
1730

1731
    call set_g_from_moment_facs(g, phiinit, phiz, dfac_species_weight = .true., &
1732
         ufac_species_weight = .false., use_even = even, do_reality = enforce_reality)
×
1733
    call copy(g, gnew)
×
1734
  end subroutine ginit_recon
×
1735

1736
  !> FIXME : Add documentation
1737
  !!
1738
  !! @note nl4 has been monkeyed with over time.  Do not expect to recover old results
1739
  !! that use this startup routine.
1740
  subroutine ginit_nl4
×
1741
    use species, only: spec
1742
    use gs2_save, only: gs2_restore
1743
    use theta_grid, only: ntgrid
1744
    use kt_grids, only: naky, ntheta0
1745
    use dist_fn_arrays, only: g, gnew
1746
    use le_grids, only: forbid
1747
    use fields_arrays, only: phi, apar, bpar
1748
    use fields_arrays, only: phinew, aparnew, bparnew
1749
    use gs2_layouts, only: g_lo, ik_idx, it_idx, is_idx, il_idx
1750
    use run_parameters, only: has_phi, has_apar, has_bpar
1751
    use ran, only: ranf
1752
    use array_utils, only: copy, zero_array
1753
    implicit none
1754
    complex, dimension (-ntgrid:ntgrid,ntheta0,naky) :: phiz
×
1755
    integer :: iglo, ig, ik, it, is, il
1756
    
1757
    call gs2_restore (g, scale, has_phi, has_apar, has_bpar)
×
1758

1759
    do iglo = g_lo%llim_proc, g_lo%ulim_proc
×
1760
       it = it_idx(g_lo,iglo)
×
1761
       ik = ik_idx(g_lo,iglo)
×
1762
       if (it == 1 .and. ik == 2) cycle
×
1763
       g (:,:,iglo) = 0.
×
1764
    end do
1765

1766
    do ik = 1, naky
×
1767
       do it=1,ntheta0
×
1768
          if (it == 1 .and. ik == 2) cycle
×
1769
          phinew(:,it,ik) = 0.
×
1770
          aparnew(:,it,ik) = 0.
×
1771
          bparnew(:,it,ik) = 0.
×
1772
          phi(:,it,ik) = 0.
×
1773
          apar(:,it,ik) = 0.
×
1774
          bpar(:,it,ik) = 0.          
×
1775
       end do
1776
    end do
1777
    
1778
    do ik = 1, naky
×
1779
       do it = 1, ntheta0
×
1780
          do ig = -ntgrid, ntgrid
×
1781
             phiz(ig,it,ik) = cmplx(ranf()-0.5,ranf()-0.5)
×
1782
          end do
1783
       end do
1784
    end do
1785

1786
    call do_chop_side(phiz)
×
1787
    call apply_reality(phiz)
×
1788

1789
    do iglo = g_lo%llim_proc, g_lo%ulim_proc
×
1790
       ik = ik_idx(g_lo,iglo)
×
1791
       it = it_idx(g_lo,iglo)
×
1792
       il = il_idx(g_lo,iglo)
×
1793
       is = is_idx(g_lo,iglo)
×
1794
       g(:,1,iglo) = g(:,1,iglo)-phiz(:,it,ik)*spec(is)%z*phiinit
×
1795
       where (forbid(:,il)) g(:,1,iglo) = 0.0
×
1796
       g(:, 2, iglo) = g(:, 1, iglo)
×
1797
    end do
1798
    call copy(g, gnew)
×
1799
  end subroutine ginit_nl4
×
1800

1801
  !> FIXME : Add documentation. This is near identical to ginit_nl4 aside from initial zeroing
1802
  subroutine ginit_nl5
×
1803
    use species, only: spec
1804
    use gs2_save, only: gs2_restore
1805
    use theta_grid, only: ntgrid
1806
    use kt_grids, only: naky, ntheta0
1807
    use dist_fn_arrays, only: g, gnew
1808
    use le_grids, only: forbid
1809
    use fields_arrays, only: phi, apar, bpar
1810
    use fields_arrays, only: phinew, aparnew, bparnew
1811
    use gs2_layouts, only: g_lo, ik_idx, it_idx, is_idx, il_idx
1812
    use run_parameters, only: has_phi, has_apar, has_bpar
1813
    use ran, only: ranf
1814
    use array_utils, only: copy, zero_array
1815
    implicit none
1816
    complex, dimension (-ntgrid:ntgrid,ntheta0,naky) :: phiz
×
1817
    integer :: iglo, ig, ik, it, is, il
1818
    call gs2_restore (g, scale, has_phi, has_apar, has_bpar)
×
1819

1820
    do iglo = g_lo%llim_proc, g_lo%ulim_proc
×
1821
       ik = ik_idx(g_lo, iglo)
×
1822
       if (ik == 1) cycle
×
1823
       g (:, :, iglo) = 0.
×
1824
    end do
1825

1826
    phinew(:,:,2:naky) = 0.
×
1827
    aparnew(:,:,2:naky) = 0.
×
1828
    bparnew(:,:,2:naky) = 0.
×
1829
    phi(:,:,2:naky) = 0.
×
1830
    apar(:,:,2:naky) = 0.
×
1831
    bpar(:,:,2:naky) = 0.
×
1832

1833
    do ik = 1, naky
×
1834
       do it = 1, ntheta0
×
1835
          do ig = -ntgrid, ntgrid
×
1836
             phiz(ig,it,ik) = cmplx(ranf()-0.5,ranf()-0.5)
×
1837
          end do
1838
       end do
1839
    end do
1840

1841
    call do_chop_side(phiz)
×
1842
    call apply_reality(phiz)
×
1843

1844
    do iglo = g_lo%llim_proc, g_lo%ulim_proc
×
1845
       ik = ik_idx(g_lo,iglo)
×
1846
       it = it_idx(g_lo,iglo)
×
1847
       il = il_idx(g_lo,iglo)
×
1848
       is = is_idx(g_lo,iglo)
×
1849
       g(:,1,iglo) = g(:,1,iglo)-phiz(:,it,ik)*phiinit*spec(is)%z
×
1850
       where (forbid(:,il)) g(:,1,iglo) = 0.0
×
1851
       g(:, 2, iglo) = g(:, 1, iglo)
×
1852
    end do
1853
    call copy(g, gnew)
×
1854
  end subroutine ginit_nl5
×
1855

1856
  !> FIXME : Add documentation  
1857
  subroutine ginit_nl6
×
1858
    use gs2_save, only: gs2_restore
1859
    use kt_grids, only: ntheta0
1860
    use dist_fn_arrays, only: g, gnew
1861
    use fields_arrays, only: phi, apar, bpar
1862
    use fields_arrays, only: phinew, aparnew, bparnew
1863
    use gs2_layouts, only: g_lo, ik_idx, it_idx, is_idx, il_idx
1864
    use run_parameters, only: has_phi, has_apar, has_bpar
1865
    use array_utils, only: copy, zero_array
1866
    implicit none
1867
    integer :: iglo, ik, it
1868
    
1869
    call gs2_restore (g, scale, has_phi, has_apar, has_bpar)
×
1870
    call zero_array(gnew)
×
1871

1872
    do iglo = g_lo%llim_proc, g_lo%ulim_proc
×
1873
       ik = ik_idx(g_lo,iglo)
×
1874
       it = it_idx(g_lo,iglo)
×
1875
       if (ik == 1 .and. it == 2) cycle
×
1876
       if (ik == 1 .and. it == ntheta0) cycle
×
1877
       g(:,:,iglo) = 0.
×
1878
    end do
1879

1880
    phinew(:,2,1) = 0.   
×
1881
    aparnew(:,2,1) = 0.
×
1882
    bparnew(:,2,1) = 0.
×
1883

1884
    phi(:,2,1) = 0.
×
1885
    apar(:,2,1) = 0.
×
1886
    bpar(:,2,1) = 0.
×
1887

1888
    phinew(:,ntheta0,1) = 0.
×
1889
    aparnew(:,ntheta0,1) = 0.
×
1890
    bparnew(:,ntheta0,1) = 0.
×
1891

1892
    phi(:,ntheta0,1) = 0.
×
1893
    apar(:,ntheta0,1) = 0.
×
1894
    bpar(:,ntheta0,1) = 0.
×
1895

1896
    call copy(g, gnew)
×
1897
  end subroutine ginit_nl6
×
1898

1899
  !> FIXME : Add documentation  
1900
  subroutine ginit_nl7
×
1901
    use theta_grid, only: ntgrid
1902
    use kt_grids, only: naky, ntheta0, enforce_reality
1903
    use dist_fn_arrays, only: g, gnew
1904
    use array_utils, only: copy
1905
    implicit none
1906
    complex, dimension (-ntgrid:ntgrid,ntheta0,naky) :: phi
×
1907
    integer :: ig, ik, it, j
1908
    do it = 1, ntheta0
×
1909
       do ik = 1, naky
×
1910
          phi(:,it,ik) = cmplx(refac,imfac) * dphiinit
×
1911
       end do
1912
    end do
1913

1914
    do j = 1, 2
×
1915
       ik = ikk(j)
×
1916
       it = itt(j)
×
1917
       do ig = -ntgrid, ntgrid
×
1918
          phi(ig,it,ik) = cmplx(refac, imfac)
×
1919
       end do
1920
    end do
1921

1922
    call set_g_from_moment_facs(g, phiinit, phi, dfac_species_weight = .true., &
1923
         ufac_species_weight = .false., use_even = even, do_reality = enforce_reality)
×
1924
    call copy(g, gnew)
×
1925
  end subroutine ginit_nl7
×
1926

1927
  !> Orszag-Tang 2D vortex problem
1928
  subroutine ginit_ot
×
1929
    use species, only: spec
1930
    use theta_grid, only: ntgrid
1931
    use kt_grids, only: naky, nakx => ntheta0, enforce_reality, kperp2
1932
    use dist_fn_arrays, only: g, gnew, vpa
1933
    use gs2_layouts, only: g_lo, ik_idx, it_idx, is_idx
1934
    use fields_arrays, only: phinew, aparnew, bparnew
1935
    use dist_fn, only: get_init_field
1936
    use array_utils, only: copy, zero_array
1937
    implicit none
1938
    integer :: iglo, ik, it, is, i
1939
    complex :: fac
1940
    complex, dimension (-ntgrid:ntgrid,nakx,naky) :: phi, jpar ! local !
×
1941
    real, dimension (-ntgrid:ntgrid) :: dfac, ufac
×
1942

1943
    !! phi, jpar are local !!
1944
    call zero_array(phi) ; call zero_array(jpar)
×
1945
    !$    phi(:,1,2) = phiinit * cmplx(2.0, 0.0)  ! 2 cos(y)
1946
    !$    phi(:,2,1) = phiinit * cmplx(1.0, 0.0)  ! 2 cos(x)
1947
    !$    jpar(:,1,2) = apar0 * cmplx(2.0, 0.0) ! 2 cos(y)
1948
    !$    jpar(:,3,1) = apar0 * cmplx(2.0, 0.0) ! 4 cos(2x)
1949
    do i=1, 3
×
1950
       it = ittt(i)
×
1951
       ik = ikkk(i)
×
1952
       phi(:,it,ik) = phiamp(i)
×
1953
       jpar(:,it,ik) = aparamp(i) * kperp2(:,it,ik)
×
1954
    end do
1955

1956
    if (enforce_reality) then
×
1957
       call apply_reality(phi)
×
1958
       call apply_reality(jpar)
×
1959
    end if
1960

1961
    dfac     = den0
×
1962
    ufac     = upar0
×
1963

1964
    do iglo = g_lo%llim_proc, g_lo%ulim_proc
×
1965
       it = it_idx(g_lo,iglo)
×
1966
       ik = ik_idx(g_lo,iglo)
×
1967
       is = is_idx(g_lo,iglo)
×
1968

1969
       g(:,1,iglo) = &
×
1970
            ( dfac*spec(is)%dens0                * phi(:,it,ik) &
×
1971
            + 2.*ufac* vpa(:,1,iglo)*spec(is)%u0 * jpar(:,it,ik) )
×
1972

1973
       g(:,2,iglo) = &
×
1974
            ( dfac*spec(is)%dens0                * phi(:,it,ik) &
×
1975
            + 2.*ufac* vpa(:,2,iglo)*spec(is)%u0 * jpar(:,it,ik) )
×
1976

1977
    end do
1978

1979
    call copy(g, gnew)
×
1980

1981
    ! normalize
1982
    call get_init_field (phinew, aparnew, bparnew)
×
1983
    do i=1, 3
×
1984
       it = ittt(i)
×
1985
       ik = ikkk(i)
×
1986
       if (abs(phiamp(i)) > epsilon(0.0)) then
×
1987
          ! Should this include abs?
1988
          fac = phiamp(i) / phinew(0,it,ik)
×
1989
          phi(:,it,ik) = phi(:,it,ik) * fac
×
1990
       end if
1991
       if (abs(aparamp(i)) > epsilon(0.0)) then
×
1992
          fac = aparamp(i) / aparnew(0,it,ik)
×
1993
          jpar(:,it,ik) = jpar(:,it,ik) * fac
×
1994
       end if
1995
    end do
1996

1997
    if (enforce_reality) then
×
1998
       call apply_reality(phi)
×
1999
       call apply_reality(jpar)
×
2000
    end if
2001

2002
    ! redefine g
2003
    do iglo = g_lo%llim_proc, g_lo%ulim_proc
×
2004
       it = it_idx(g_lo,iglo)
×
2005
       ik = ik_idx(g_lo,iglo)
×
2006
       is = is_idx(g_lo,iglo)
×
2007

2008
       g(:,1,iglo) = &
×
2009
            ( dfac*spec(is)%dens0                * phi(:,it,ik) &
×
2010
            + 2.*ufac* vpa(:,1,iglo)*spec(is)%u0 * jpar(:,it,ik) )
×
2011

2012
       g(:,2,iglo) = &
×
2013
            ( dfac*spec(is)%dens0                * phi(:,it,ik) &
×
2014
            + 2.*ufac* vpa(:,2,iglo)*spec(is)%u0 * jpar(:,it,ik) )
×
2015

2016
    end do
2017
    call copy(g, gnew)
×
2018
  end subroutine ginit_ot
×
2019

2020
  !> FIXME : Add documentation
2021
  subroutine ginit_kpar
×
2022
    use species, only: spec, has_electron_species
2023
    use theta_grid, only: ntgrid, theta
2024
    use kt_grids, only: naky, ntheta0, theta0
2025
    use dist_fn_arrays, only: g, gnew
2026
    use array_utils, only: copy
2027
    implicit none
2028
    complex, dimension (-ntgrid:ntgrid,ntheta0,naky) :: phi
×
2029
    integer :: ig
2030
    
2031
    if (width0 > 0.) then
×
2032
       do ig = -ntgrid, ntgrid
×
2033
          phi(ig,:,:) = exp(-((theta(ig)-theta0(:,:))/width0)**2)*cmplx(refac, imfac)
×
2034
       end do
2035
    else
2036
       do ig = -ntgrid, ntgrid
×
2037
          phi(ig,:,:) = cmplx(refac, imfac)
×
2038
       end do
2039
    end if
2040

2041
    call do_chop_side(phi)
×
2042

2043
    call set_g_from_moment_facs(g, phiinit, phi, dfac_species_weight = .false., &
2044
         ufac_species_weight = .false., use_even= .true., do_reality = .false.)
×
2045

2046
    if (has_electron_species(spec)) then
×
2047
       call flae (g, gnew)
×
2048
       g = g - gnew
×
2049
    end if
2050
    call copy(g, gnew)
×
2051
  end subroutine ginit_kpar
×
2052

2053
  !> FIXME : Add documentation  
2054
  subroutine ginit_gs
×
2055
    use species, only: spec, has_electron_species
2056
    use theta_grid, only: ntgrid, theta
2057
    use kt_grids, only: naky, ntheta0
2058
    use le_grids, only: forbid
2059
    use dist_fn_arrays, only: g, gnew, vpa, vperp2
2060
    use gs2_layouts, only: g_lo, ik_idx, it_idx, il_idx, is_idx
2061
    use constants, only: pi, zi
2062
    use ran, only: ranf
2063
    use array_utils, only: copy
2064
    implicit none
2065
    complex, dimension (-ntgrid:ntgrid,ntheta0,naky) :: phi, odd
×
2066
    integer :: iglo, ik, it, il, is
2067
    real :: phase
2068
    do ik=1,naky
×
2069
       do it=1,ntheta0
×
2070
          phase = 2.*pi*ranf()
×
2071
          phi(:,it,ik) = cos(theta+phase)*cmplx(refac,imfac)
×
2072
          odd(:,it,ik) = sin(theta+phase)*cmplx(refac,imfac) * zi
×
2073
       end do
2074
    end do
2075
  
2076
    !Should this be triggered for kt_grids::reality=.true. only?
2077
    call apply_reality(phi)
×
2078
    call apply_reality(odd)
×
2079

2080
    ! charge dependence keeps initial Phi from being too small
2081
    ! Note not quite suitable for set_g_from_moment_facs as dfac --> den1 etc.
2082
    do iglo = g_lo%llim_proc, g_lo%ulim_proc
×
2083
       ik = ik_idx(g_lo,iglo)
×
2084
       it = it_idx(g_lo,iglo)
×
2085
       il = il_idx(g_lo,iglo)
×
2086
       is = is_idx(g_lo,iglo)       
×
2087

2088
       g(:,1,iglo) = phiinit* &!spec(is)%z* &
×
2089
            ( den1                         * phi(:,it,ik) &
×
2090
            + 2.*upar1* vpa(:,1,iglo)      * odd(:,it,ik) &
×
2091
            + tpar1*(vpa(:,1,iglo)**2-0.5) * phi(:,it,ik) &
×
2092
            + tperp1*(vperp2(:,iglo)-1.)   * phi(:,it,ik))
×
2093
       where (forbid(:,il)) g(:,1,iglo) = 0.0
×
2094
       
2095
       g(:,2,iglo) = phiinit* &!spec(is)%z* &
×
2096
            ( den1                         * phi(:,it,ik) &
×
2097
            + 2.*upar1* vpa(:,2,iglo)      * odd(:,it,ik) &
×
2098
            + tpar1*(vpa(:,2,iglo)**2-0.5) * phi(:,it,ik) &
×
2099
            + tperp1*(vperp2(:,iglo)-1.)   * phi(:,it,ik))
×
2100
       where (forbid(:,il)) g(:,2,iglo) = 0.0
×
2101

2102
    end do
2103

2104
    if (has_electron_species(spec)) then
×
2105
       call flae (g, gnew)
×
2106
       g = g - gnew
×
2107
    end if
2108

2109
    call copy(g, gnew)
×
2110
  end subroutine ginit_gs
×
2111

2112
  !> FIXME : Add documentation  
2113
  subroutine ginit_xi
×
2114
    use theta_grid, only: ntgrid, theta, bmag
2115
    use le_grids, only: forbid, al
2116
    use kt_grids, only: theta0
2117
    use dist_fn_arrays, only: g, gnew
2118
    use gs2_layouts, only: g_lo, ik_idx, it_idx, il_idx
2119
    use array_utils, only: copy
2120
    implicit none
2121
    integer :: iglo, ik, it, il
2122
    real, dimension(-ntgrid:ntgrid) :: xi
×
2123

2124
    do iglo = g_lo%llim_proc, g_lo%ulim_proc
×
2125
       ik = ik_idx(g_lo,iglo)
×
2126
       it = it_idx(g_lo,iglo)
×
2127
       il = il_idx(g_lo,iglo)
×
2128
       xi = sqrt(max(1.0-bmag*al(il),0.0))
×
2129
       g(:,1,iglo) = xi*exp(-((theta-theta0(it,ik))/width0)**2)
×
2130
       where (forbid(:,il)) g(:,1,iglo) = 0.0
×
2131
       g(:,2,iglo) = -g(:,1,iglo)
×
2132
    end do
2133
    call copy(g, gnew)
×
2134
  end subroutine ginit_xi
×
2135

2136
  !> FIXME : Add documentation  
2137
  subroutine ginit_xi2
×
2138
    use theta_grid, only: ntgrid, theta, bmag
2139
    use le_grids, only: forbid, al
2140
    use kt_grids, only: theta0
2141
    use dist_fn_arrays, only: g, gnew
2142
    use gs2_layouts, only: g_lo, ik_idx, it_idx, il_idx
2143
    use array_utils, only: copy
2144
    implicit none
2145
    integer :: iglo, ik, it, il
2146
    real, dimension(-ntgrid:ntgrid) :: xi
×
2147

2148
    do iglo = g_lo%llim_proc, g_lo%ulim_proc
×
2149
       ik = ik_idx(g_lo,iglo)
×
2150
       it = it_idx(g_lo,iglo)
×
2151
       il = il_idx(g_lo,iglo)
×
2152
       xi = sqrt(max(1.0-bmag*al(il),0.0))
×
2153
       g(:,1,iglo) = (1.0 - 3.0*xi*xi)*exp(-((theta-theta0(it,ik))/width0)**2)
×
2154
       where (forbid(:,il)) g(:,1,iglo) = 0.0
×
2155
       g(:,2,iglo) = g(:,1,iglo)
×
2156
    end do
2157
    call copy(g, gnew)
×
2158
  end subroutine ginit_xi2
×
2159

2160
  !> FIXME : Add documentation  
2161
  subroutine ginit_rh
×
2162
    use le_grids, only: forbid, energy
2163
    use dist_fn_arrays, only: g, gnew
2164
    use gs2_layouts, only: g_lo, il_idx, ie_idx, is_idx
2165
    use array_utils, only: copy    
2166
    implicit none
2167
    integer :: iglo, il, ie, is
2168

2169
    do iglo = g_lo%llim_proc, g_lo%ulim_proc
×
2170
       il = il_idx(g_lo,iglo)
×
2171
       ie = ie_idx(g_lo,iglo)
×
2172
       is = is_idx(g_lo,iglo)
×
2173
       g(:,1,iglo) = exp(-energy(ie,is))
×
2174
       where (forbid(:,il)) g(:,1,iglo) = 0.0
×
2175
       g(:,2,iglo) = g(:,1,iglo)
×
2176
    end do
2177
    call copy(g, gnew)
×
2178
  end subroutine ginit_rh
×
2179

2180
  !> FIXME : Add documentation
2181
  subroutine ginit_alf
×
2182
    use theta_grid, only: theta
2183
    use le_grids, only: forbid
2184
    use dist_fn_arrays, only: g, gnew, vpa
2185
    use gs2_layouts, only: g_lo, il_idx, is_idx
2186
    use species, only: spec, is_electron_species
2187
    use array_utils, only: copy
2188
    implicit none
2189
    integer :: iglo, il, is
2190

2191
    do iglo = g_lo%llim_proc, g_lo%ulim_proc
×
2192
       is = is_idx(g_lo,iglo)
×
2193
       if (is_electron_species(spec(is))) cycle
×
2194
       il = il_idx(g_lo,iglo)
×
2195
       g(:,1,iglo) = sin(theta)*vpa(:,1,iglo)*spec(is)%z
×
2196
       where (forbid(:,il)) g(:,1,iglo) = 0.0
×
2197
       g(:,2,iglo) = sin(theta)*vpa(:,2,iglo)*spec(is)%z
×
2198
       where (forbid(:,il)) g(:,2,iglo) = 0.0
×
2199
    end do
2200
    g = phiinit * g 
×
2201
    call copy(g, gnew)
×
2202
  end subroutine ginit_alf
×
2203

2204
  !> FIXME : Add documentation
2205
  subroutine ginit_zero
×
2206
    use dist_fn_arrays, only: g, gnew
2207
    use array_utils, only: zero_array
2208
    implicit none
2209
    call zero_array(g)
×
2210
    call zero_array(gnew)
×
2211
  end subroutine ginit_zero
×
2212

2213
  !> FIXME : Add documentation  
2214
  subroutine ginit_test3
×
2215
    use dist_fn_arrays, only: g, gnew, vpa
2216
    use theta_grid, only: ntgrid, delthet, bmag
2217
    use kt_grids, only: akx
2218
    use theta_grid_params, only: eps, epsl, pk
2219
    use gs2_layouts, only: g_lo, ik_idx, il_idx
2220
    use mp, only: broadcast
2221
    use constants, only: zi
2222
    use array_utils, only: copy
2223
    use warning_helpers, only: is_zero
2224
    implicit none
2225
    integer :: iglo, ik, il
2226
    real :: c1, c2
2227

2228
    call broadcast (epsl)
×
2229
    call broadcast (eps)
×
2230
    call broadcast (pk)
×
2231

2232
    do iglo = g_lo%llim_proc, g_lo%ulim_proc
×
2233
       ik = ik_idx(g_lo,iglo)
×
2234
       il = il_idx(g_lo,iglo)
×
2235
       if (any(is_zero(vpa(-ntgrid:ntgrid-1,:,iglo)))) then
×
2236
          c1 = 0.0
×
2237
          c2 = 0.0
×
2238
       else
2239
          c2 = -akx(ik)*epsl/eps/pk &
×
2240
               *sum(delthet(-ntgrid:ntgrid-1)/bmag(-ntgrid:ntgrid-1))
×
2241
          c1 = c2/sum(delthet(-ntgrid:ntgrid-1)/vpa(-ntgrid:ntgrid-1,1,iglo))
×
2242
          c2 = c2/sum(delthet(-ntgrid:ntgrid-1)/vpa(-ntgrid:ntgrid-1,2,iglo))
×
2243
       end if
2244
       g(:,1,iglo) = -zi*akx(ik)*epsl/eps/pk*vpa(:,1,iglo)/bmag - zi*c1
×
2245
       g(:,2,iglo) = -zi*akx(ik)*epsl/eps/pk*vpa(:,2,iglo)/bmag - zi*c2
×
2246
    end do
2247
    call copy(g, gnew)
×
2248
  end subroutine ginit_test3
×
2249

2250
  !> FIXME : Add documentation  
2251
  subroutine ginit_convect
×
2252
    use dist_fn_arrays, only: g, gnew
2253
    use theta_grid, only: theta
2254
    use kt_grids, only: theta0
2255
    use gs2_layouts, only: g_lo, it_idx, ik_idx
2256
    use array_utils, only: copy
2257
    implicit none
2258
    integer :: it, ik, iglo
2259

2260
    do iglo = g_lo%llim_proc, g_lo%ulim_proc
×
2261
       it = it_idx(g_lo,iglo)
×
2262
       ik = ik_idx(g_lo,iglo)
×
2263
       g(:,1,iglo) = exp(cmplx(-(theta-theta0(it,ik))**2,k0*theta))
×
2264
       g(:,2,iglo) = g(:,1,iglo)
×
2265
    end do
2266
    call copy(g, gnew)
×
2267
  end subroutine ginit_convect
×
2268

2269
  !> FIXME : Add documentation  
2270
  subroutine ginit_recon3
×
2271
    use mp, only: proc0, mp_abort
2272
    use species, only: nspec, spec, has_electron_species
2273
    use theta_grid, only: ntgrid, theta
2274
    use kt_grids, only: naky, nakx => ntheta0, akx, aky, enforce_reality
2275
    use kt_grids, only: nx,ny,kperp2
2276
    use dist_fn_arrays, only: g, gnew, vpa, vperp2
2277
    use gs2_layouts, only: g_lo, ik_idx, it_idx, is_idx
2278
    use gs2_transforms, only: inverse2,transform2
2279
    use run_parameters, only: beta
2280
    use le_grids, only: integrate_moment
2281
    use dist_fn, only: gamtot, gamtot1, gamtot2, get_init_field
2282
    use constants, only: pi, zi
2283
    use file_utils, only: error_unit, open_output_file, close_output_file
2284
    use ran, only: ranf
2285
    use array_utils, only: copy
2286
    use warning_helpers, only: not_exactly_equal, is_not_zero, is_zero
2287
    implicit none
2288
    integer, parameter :: ncnt_mom_coeff=8
2289
    real, dimension(:, :, :, :), allocatable :: mom_coeff
×
2290
    real, dimension(:, :, :), allocatable :: mom_shift_para, mom_shift_perp
×
2291
    real :: bsq
2292
    integer :: iglo, ig, ik, it, is, i, j
2293

2294
    ! nkxyz and ukxyz determine profiles in kx-ky plane
2295
    ! nkxyz is for N, T, and ukxyz is for U
2296
    ! [do not control amplitude by these variables]
2297
    complex :: nkxyz(-ntgrid:ntgrid,nakx,naky)
×
2298
    complex :: ukxyz(-ntgrid:ntgrid,nakx,naky)
×
2299
    complex :: nkxyz_eq(-ntgrid:ntgrid,nakx,naky)
×
2300
    complex :: ukxyz_eq(-ntgrid:ntgrid,nakx,naky)
×
2301
    complex, allocatable :: g_eq(:,:,:)
×
2302

2303
    ! equilibrium and perturbation
2304
    complex :: nkxy_eq(nakx,naky), ukxy_eq(nakx,naky)
×
2305

2306
    ! *fac determine z profile
2307
    ! [do not control amplitude by these variables]
2308
    real :: dfac(-ntgrid:ntgrid), ufac(-ntgrid:ntgrid)
×
2309
    real :: tparfac(-ntgrid:ntgrid), tperpfac(-ntgrid:ntgrid)
×
2310
    real :: ct(-ntgrid:ntgrid), st(-ntgrid:ntgrid)
×
2311
    real :: c2t(-ntgrid:ntgrid), s2t(-ntgrid:ntgrid)
×
2312

2313
    ! normalization
2314
    real :: fac
2315
    real, allocatable :: nnrm(:,:,:),unrm(:,:,:)
×
2316
    real, allocatable :: tparanrm(:,:,:),tperpnrm(:,:,:)
×
2317

2318
    real :: check(3), current
2319
    character (len=2) :: cfit
2320
    complex, allocatable :: phi(:,:,:), apar(:,:,:), bpar(:,:,:)
×
2321
    real :: save_dens0, save_tperp0, save_u0, ratio
2322

2323
    ! real space profile to be Fourier transformed
2324
    real :: xx,dx,lx,ly
2325
    integer, parameter :: nfxp=2**10
2326
    integer :: nfx
2327
    real, allocatable :: nxy(:,:), uxy(:,:)
×
2328
    real, allocatable :: phixy(:,:,:), aparxy(:,:,:), bparxy(:,:,:)
×
2329

2330
    complex, allocatable :: by(:,:,:)
×
2331
    real, allocatable :: byxy(:,:,:)
×
2332
    integer :: nnx, nny, unit
2333
    real :: xmax, bymax, xa, xl1, xl2, fmin, fmax, a, b
2334

2335
    if(debug.and.proc0) write(6,*) 'Initialization recon3'
2336

2337
    cfit = 'A0'
×
2338
    check = 0
×
2339
    current = 0
×
2340
    nfx = nfxp
×
2341
    if (nfxp < nx) nfx=nx
×
2342

2343
    !! adjust input parameters to kill initial field if wanted
2344
    if(debug.and.proc0) write(6,*) 'check parameters'
2345

2346
    do is=1,nspec
×
2347
       if(adj_spec == is) cycle
×
2348
       check(1)=check(1)+spec(is)%z*spec(is)%dens*spec(is)%dens0
×
2349
       check(2)=check(2)+spec(is)%dens*spec(is)%temp* &
×
2350
            & (spec(is)%dens0+spec(is)%tperp0)
×
2351
       check(3)=check(3)+spec(is)%z*spec(is)%dens*spec(is)%stm*spec(is)%u0
×
2352
    end do
2353

2354
    if(adj_spec == 0) then
×
2355
       ! just warn if fields don't satisfy given conditions
2356
       if(null_phi .and. null_bpar) then
×
2357
          if (is_not_zero(sum(check(1:2)))) then
×
2358
             if(proc0) write(6,'(a)') 'WARNING: finite Phi or Bpar in initial condition'
×
2359
          endif
2360
       else if(null_bpar .and. .not. null_phi) then
×
2361
          ratio=gamtot1(0,eq_mode_n+1,1)/gamtot(0,eq_mode_n+1,1)
×
2362
          if (not_exactly_equal(check(1)/check(2), ratio)) then
×
2363
             if(proc0) write(6,'(a)') 'WARNING: finite Bpar in initial condition'
×
2364
          endif
2365
       else if(null_phi .and. .not. null_bpar) then
×
2366
          ratio=-(2.*gamtot2(0,eq_mode_n+1,1)+2./beta) &
×
2367
               & /gamtot1(0,eq_mode_n+1,1)
×
2368
          if (not_exactly_equal(check(1)/check(2), ratio)) then
×
2369
             if (proc0) write(6,'(a)') 'WARNING: finite Bpar in initial condition'
×
2370
          endif
2371
       endif
2372
       if (null_apar) then
×
2373
          if (is_not_zero(check(3))) then
×
2374
             if (proc0) write(6,'(a)') 'WARNING: finite Apar in initial condition'
×
2375
          end if
2376
       end if
2377
    else
2378
       ! adjust input parameter to satisfy given conditions
2379
       if (null_phi .and. null_bpar) then
×
2380
          save_dens0=spec(adj_spec)%dens0
×
2381
          save_tperp0=spec(adj_spec)%tperp0
×
2382
          spec(adj_spec)%dens0=-check(1)/(spec(adj_spec)%z*spec(adj_spec)%dens)
×
2383
          spec(adj_spec)%tperp0=-spec(adj_spec)%dens0 &
×
2384
               & -check(2)/(spec(adj_spec)%dens*spec(adj_spec)%temp)
×
2385

2386
          if (not_exactly_equal(spec(adj_spec)%dens0, save_dens0)) then
×
2387
             if (proc0) write(6,'(a,i0,a,f10.2,a)') &
×
2388
                  & 'WARNING: Initial density of spec=', spec(adj_spec)%type, &
×
2389
                  & ' is adjusted to ', spec(adj_spec)%dens0, &
×
2390
                  & ' to kill Phi and Bpar'
×
2391
          endif
2392
          if (not_exactly_equal(spec(adj_spec)%tperp0, save_tperp0)) then
×
2393
             if (proc0) write(6,'(a,i0,a,f10.2,a)') &
×
2394
                  & 'WARNING: Initial Tperp of spec=', spec(adj_spec)%type, &
×
2395
                  & ' is adjusted to ', spec(adj_spec)%tperp0, &
×
2396
                  & ' to kill Phi and Bpar'
×
2397
          endif
2398
       else if(null_bpar .and. .not. null_phi .and. eq_type=='sinusoidal') then
×
2399
          save_tperp0=spec(adj_spec)%tperp0
×
2400
          check(1)=check(1)+ &
2401
               & spec(adj_spec)%z*spec(adj_spec)%dens*spec(adj_spec)%dens0
×
2402
          ratio=gamtot1(0,eq_mode_n+1,1)/gamtot(0,eq_mode_n+1,1)
×
2403

2404
          spec(adj_spec)%tperp0=(-check(1)*ratio-check(2)) &
×
2405
               & /(spec(adj_spec)%dens*spec(adj_spec)%temp) &
×
2406
               & -spec(adj_spec)%dens0
×
2407
          if (not_exactly_equal(spec(adj_spec)%tperp0, save_tperp0)) then
×
2408
             if (proc0) write(6,'(a,i0,a,f10.2,a)') &
×
2409
                  & 'WARNING: Initial Tperp of spec=', spec(adj_spec)%type, &
×
2410
                  & ' is adjusted to ', spec(adj_spec)%tperp0, &
×
2411
                  & ' to kill Bpar'
×
2412
          endif
2413
       else if(null_phi .and. .not. null_bpar .and. eq_type=='sinusoidal') then
×
2414
          save_tperp0=spec(adj_spec)%tperp0
×
2415
          check(1)=check(1)+ &
2416
               & spec(adj_spec)%z*spec(adj_spec)%dens*spec(adj_spec)%dens0
×
2417
          ratio=-(2.*gamtot2(0,eq_mode_n+1,1)+2./beta) &
×
2418
               & /gamtot1(0,eq_mode_n+1,1)
×
2419

2420
          spec(adj_spec)%tperp0=(-check(1)*ratio-check(2)) &
×
2421
               & /(spec(adj_spec)%dens*spec(adj_spec)%temp) &
×
2422
               & -spec(adj_spec)%dens0
×
2423

2424
          if (not_exactly_equal(spec(adj_spec)%tperp0, save_tperp0)) then
×
2425
             if (proc0) write(6,'(a,i0,a,f10.2,a)') &
×
2426
                  & 'WARNING: Initial Tperp of spec=', spec(adj_spec)%type, &
×
2427
                  & ' is adjusted to ', spec(adj_spec)%tperp0, &
×
2428
                  & ' to kill Phi'
×
2429
          endif
2430
       endif
2431

2432
       if (null_apar) then
×
2433
          save_u0=spec(adj_spec)%u0
×
2434
          spec(adj_spec)%u0=-check(3)/ &
×
2435
               & (spec(adj_spec)%z*spec(adj_spec)%dens*spec(adj_spec)%stm)
×
2436
          if (not_exactly_equal(spec(adj_spec)%u0, save_u0)) then
×
2437
             if (proc0) write(6,'(a,i0,a,f10.2,a)') &
×
2438
                  & 'WARNING: Initial U of spec=', spec(adj_spec)%type, &
×
2439
                  & ' is adjusted to ', spec(adj_spec)%u0, &
×
2440
                  & ' to kill Apar'
×
2441
          endif
2442
       endif
2443
    endif
2444

2445
    !! initialize
2446
    if(debug.and.proc0) write(6,*) 'initialize variable'
2447
    nkxyz(-ntgrid:ntgrid,1:nakx,1:naky)=cmplx(0.,0.)
×
2448
    ukxyz(-ntgrid:ntgrid,1:nakx,1:naky)=cmplx(0.,0.)
×
2449
    nkxyz_eq(-ntgrid:ntgrid,1:nakx,1:naky)=cmplx(0.,0.)
×
2450
    ukxyz_eq(-ntgrid:ntgrid,1:nakx,1:naky)=cmplx(0.,0.)
×
2451

2452
    nkxy_eq(1:nakx,1:naky)=cmplx(0.,0.)
×
2453
    ukxy_eq(1:nakx,1:naky)=cmplx(0.,0.)
×
2454

2455
    dfac(-ntgrid:ntgrid)=1.
×
2456
    ufac(-ntgrid:ntgrid)=1.
×
2457
    tparfac(-ntgrid:ntgrid)=1.
×
2458
    tperpfac(-ntgrid:ntgrid)=1.
×
2459

2460
    !! equilibrium
2461
    if (is_not_zero(phiinit0)) then
×
2462
       if (nakx==1 .and. naky==1) then ! grid_option = single case
×
2463
          nkxy_eq(1,1)=cmplx(.5,0.)
×
2464
          ukxy_eq(1,1)=cmplx(.5,0.)
×
2465
       else
2466
          if (debug .and. proc0) write(6,*) 'set equilibrium profile'
2467
          allocate(nxy(nfx,ny),uxy(nfx,ny))
×
2468
          lx=2.*pi/(akx(2)-akx(1)); ly=2.*pi/(aky(2)-aky(1))
×
2469
          dx=lx/nfx
×
2470
          ! if width is negative, it gives the ratio to the box size
2471
          if(prof_width < 0. ) prof_width=-prof_width*lx
×
2472
          select case (eq_type)
×
2473
          case ('sinusoidal')
2474
             ! this gives n,Tpara,Tperp \propto cos^2 (2 pi/Lx)
2475
             ! nxy(eq_mode1(1),eq_mode1(2))=cmplx(.25, 0.)
2476
             ! this gives Apara \propto cos(2 pi/Lx), By \propto sin(2 pi x/Lx)
2477
             ! uxy(eq_mode2(1),eq_mode2(2))=cmplx(.5, 0.)
2478
             do it=1,nfx
×
2479
                xx=dx*(it-1)
×
2480
                nxy(it,1:ny)=0.
×
2481
                uxy(it,1:ny)=cos(2.*pi/lx*xx*eq_mode_u)
×
2482
             end do
2483
          case ('porcelli')
2484
             do it=1,nfx
×
2485
                xx=dx*(it-1)
×
2486
                nxy(it,1:ny)=0.
×
2487
                uxy(it,1:ny)=1./cosh((xx-.5*lx)/prof_width)**2 &
×
2488
                     & * (tanh(2.*pi/lx*xx)**2+tanh(2.*pi/lx*(xx-lx))**2 &
2489
                     & - tanh(2.*pi)**2) / (2.*tanh(pi)**2-tanh(2.*pi)**2)
×
2490
             end do
2491
          case ('doubleharris')
2492
             do it=1,nfx
×
2493
                fmin=tanh(.75*lx/prof_width)-tanh(.25*lx/prof_width)
×
2494
                fmax=2.*tanh(.25*lx/prof_width)
×
2495
                xx=dx*(it-1)
×
2496
                nxy(it,1:ny)=0.
×
2497
                uxy(it,1:ny)= 2.*( &
×
2498
                     & tanh((xx-.25*lx)/prof_width) - &
2499
                     & tanh((xx-.75*lx)/prof_width) - fmin)/(fmax-fmin)-1.
×
2500
             end do
2501
          case default
2502
             if(proc0) write(error_unit(),'(2a)') &
×
2503
                  & 'ERROR: Invalid equilibrium type', eq_type
×
2504
             call mp_abort('Invalid equilibrium type')
×
2505
          end select
2506
          ! subtract (0,0) mode
2507
          ! since it (constant part of potential) does nothing
2508
          do ik=1,ny
×
2509
             uxy(1:nfx,ik)=uxy(1:nfx,ik) &
×
2510
                  - sum(uxy(1:nfx,ik))/nfx
×
2511
          end do
2512
          call inverse2(nxy, nkxy_eq, ny, nfx)
×
2513
          call inverse2(uxy, ukxy_eq, ny, nfx)
×
2514
          deallocate(nxy,uxy)
×
2515
       endif
2516
    endif
2517

2518
    do ig = -ntgrid, ntgrid
×
2519
       nkxyz(ig,1:nakx,1:naky) = phiinit0*nkxy_eq(1:nakx,1:naky)
×
2520
       ukxyz(ig,1:nakx,1:naky) = phiinit0*ukxy_eq(1:nakx,1:naky)
×
2521
    end do
2522
    if(.not.(nakx==1 .and. naky==1)) then ! grid_option /= single case
×
2523
       nkxyz(-ntgrid:ntgrid,1,1)=cmplx(0.,0.)
×
2524
       ukxyz(-ntgrid:ntgrid,1,1)=cmplx(0.,0.)
×
2525
    endif
2526

2527
    !! save equilibrium profile
2528
    nkxyz_eq(-ntgrid:ntgrid,1:nakx,1:naky)= &
×
2529
         & nkxyz(-ntgrid:ntgrid,1:nakx,1:naky)
×
2530
    ukxyz_eq(-ntgrid:ntgrid,1:nakx,1:naky)= &
×
2531
         & ukxyz(-ntgrid:ntgrid,1:nakx,1:naky)
×
2532

2533
    !! perturbation
2534
    if (is_not_zero(phiinit)) then
×
2535
       if (debug.and.proc0) write(6,*) 'set perturbation profile'
2536
       do j = 1, 3
×
2537
          if(ikkk(j)==0) ukxy_pt(j)=.5*ukxy_pt(j) !reality
×
2538
          ik = ikkk(j)+1
×
2539
          if(ittt(j) >= 0) then
×
2540
             it = ittt(j)+1
×
2541
          else
2542
             it = nakx + ittt(j) + 1
×
2543
          endif
2544
          do ig = -ntgrid, ntgrid
×
2545
             ukxyz(ig,it,ik) = ukxyz(ig,it,ik) + phiinit*ukxy_pt(j)
×
2546
          end do
2547
       end do
2548
    endif
2549

2550
    if (is_not_zero(phiinit_rand)) then
×
2551
       do it = 1, nakx
×
2552
          do ik = 1, naky
×
2553
             a = ranf()-0.5
×
2554
             b = ranf()-0.5
×
2555
             ukxyz(:,it,ik) = ukxyz(:,it,ik) + phiinit_rand*cmplx(a,b)
×
2556
          end do
2557
       end do
2558
    end if
2559

2560
    if (debug.and.proc0) write(6,*) 'set reality condition'
2561
    if (enforce_reality) then
×
2562
       call apply_reality(nkxyz)
×
2563
       call apply_reality(ukxyz)
×
2564
       call apply_reality(nkxyz_eq)
×
2565
       call apply_reality(ukxyz_eq)
×
2566
    end if
2567

2568
    !! parallel profile
2569
    if(debug.and.proc0) write(6,*) 'set parallel profile'
2570
    if (even) then
×
2571
       ct = cos(theta)
×
2572
       st = sin(theta)
×
2573

2574
       c2t = cos(2.*theta)
×
2575
       s2t = sin(2.*theta)
×
2576
    else
2577
       ct = sin(theta)
×
2578
       st = cos(theta)
×
2579

2580
       c2t = sin(2.*theta)
×
2581
       s2t = cos(2.*theta)
×
2582
    end if
2583

2584
    dfac     = dfac     + den1   * ct + den2   * c2t
×
2585
    ufac     = ufac     + upar1  * st + upar2  * s2t
×
2586
    tparfac  = tparfac  + tpar1  * ct + tpar2  * c2t
×
2587
    tperpfac = tperpfac + tperp1 * ct + tperp2 * c2t
×
2588

2589
    !! normalization
2590
    if (debug .and. proc0) write(6,*) 'normalization'
2591
    if (is_not_zero(b0)) then
×
2592
       if (.not.(nakx==1 .and. naky==1)) then ! grid_option /= single case
×
2593
          if (eq_type == 'porcelli') then
×
2594
             xmax=.5*prof_width*log(2.+sqrt(3.))+.5*lx
×
2595
             xmax=get_xmax(xmax)
×
2596
             xa=(xmax-.5*lx)/prof_width
×
2597
             xl1=2.*pi/lx*xmax; xl2=xl1-2.*pi
×
2598
             bymax=(-2./prof_width*sinh(xa)/cosh(xa)**3* &
2599
                  & (tanh(xl1)**2+tanh(xl2)**2-tanh(2.*pi)**2) &
2600
                  & + 1./cosh(xa)**2*4.*pi/lx* &
2601
                  & (sinh(xl1)/cosh(xl1)**3+sinh(xl2)/cosh(xl2)**3) ) &
2602
                  & / (2.*tanh(pi)**2-tanh(2.*pi)**2)
×
2603
          else if(eq_type == 'doubleharris') then
×
2604
             bymax=2.*tanh(.5*lx/prof_width)**2/(prof_width*(fmax-fmin))
×
2605
          else
2606
             bymax=akx(eq_mode_u+1)
×
2607
          endif
2608
       else
2609
          bymax=sqrt(kperp2(0,1,1))
×
2610
       endif
2611
       a0 = b0/abs(bymax)
×
2612
       cfit='B0'
×
2613
    endif
2614

2615
    allocate(nnrm(nakx,naky,nspec),unrm(nakx,naky,nspec))
×
2616
    allocate(tparanrm(nakx,naky,nspec),tperpnrm(nakx,naky,nspec))
×
2617

2618
    if(.not.allocated(mom_coeff)) allocate(mom_coeff(nakx,naky,nspec,ncnt_mom_coeff))
×
2619
    if(.not.allocated(mom_shift_para)) allocate(mom_shift_para(nakx,naky,nspec))
×
2620
    if(.not.allocated(mom_shift_perp)) allocate(mom_shift_perp(nakx,naky,nspec))
×
2621

2622
    do it=1,nakx
×
2623
       do ik=1,naky
×
2624
          do is=1,nspec
×
2625
             bsq=.25*spec(is)%smz**2*kperp2(0,it,ik)
×
2626
             mom_coeff(it,ik,is,1) = exp(-bsq)
×
2627
             mom_coeff(it,ik,is,2) = exp(-bsq) *.5
×
2628
             mom_coeff(it,ik,is,3) = exp(-bsq) *(1.-bsq)
×
2629
             mom_coeff(it,ik,is,4) = exp(-bsq) *.75
×
2630
             mom_coeff(it,ik,is,5) = exp(-bsq) *(1.-bsq)*.5
×
2631
             mom_coeff(it,ik,is,6) = exp(-bsq) *.5
×
2632
             mom_coeff(it,ik,is,7) = exp(-bsq) *.25
×
2633
             mom_coeff(it,ik,is,8) = exp(-bsq) *(1.-.5*bsq)
×
2634
          end do
2635
       end do
2636
    end do
2637
    mom_shift_para=mom_coeff(:,:,:,2)/mom_coeff(:,:,:,1)
×
2638
    mom_shift_perp=mom_coeff(:,:,:,3)/mom_coeff(:,:,:,1)
×
2639

2640
    do is=1,nspec
×
2641
       nnrm(:,:,is)=mom_coeff(:,:,is,1)
×
2642
       unrm(:,:,is)=2.*mom_coeff(:,:,is,2)
×
2643
       tparanrm(:,:,is)=2.*(mom_coeff(:,:,is,4)- &
×
2644
            & 2.*mom_coeff(:,:,is,2)*mom_shift_para(:,:,is))
×
2645
       tperpnrm(:,:,is)=2.*(mom_coeff(:,:,is,8)- &
×
2646
            & mom_coeff(:,:,is,6)*mom_shift_perp(:,:,is))
×
2647

2648
       if (is_not_zero(a0)) then
×
2649
          ! rescale parallel momentum to obtain a given amplitude of Apar
2650
          current=sum(spec(1:nspec)%z*spec(1:nspec)%dens &
×
2651
               & *spec(1:nspec)%stm*spec(1:nspec)%u0)
×
2652
          if (is_zero(current)) then
×
2653
             if (proc0) write(error_unit(),'(a)') &
×
2654
                  & 'ERROR in init_g: invalid input a0, u0'
×
2655
             call mp_abort('invalid input a0, u0')
×
2656
          end if
2657
          do it=1,nakx
×
2658
             do ik=1,naky
×
2659
                if(is_not_zero(cabs(ukxyz(0,it,ik))) .and. is_not_zero(spec(is)%u0)) then
×
2660
                   fac=2.*beta*current/kperp2(0,it,ik)/a0
×
2661
                   unrm(it,ik,is)=unrm(it,ik,is)*fac
×
2662
                   if(proc0) write(6,'(a,a2,a,3(i3,1x),f20.12)') &
×
2663
                        & 'INFO: u0 is rescaled to fit ',cfit,' input', &
×
2664
                        & it,ik,is,spec(is)%u0/fac
×
2665
                end if
2666
             end do
2667
          end do
2668
       end if
2669
    end do
2670

2671
    if (debug .and. proc0) write(6,*) 'calculate g'
2672
    allocate(g_eq(-ntgrid:ntgrid,2,g_lo%llim_proc:g_lo%ulim_alloc))
×
2673
    do iglo = g_lo%llim_proc, g_lo%ulim_proc
×
2674
       ik = ik_idx(g_lo,iglo)
×
2675
       it = it_idx(g_lo,iglo)
×
2676
       is = is_idx(g_lo,iglo)
×
2677

2678
       g(:,1,iglo) = ( &
×
2679
            & ( dfac*spec(is)%dens0 / nnrm(it,ik,is) &
×
2680
            & + tparfac*spec(is)%tpar0 / tparanrm(it,ik,is) &
×
2681
            & * (vpa(:,1,iglo)**2-mom_shift_para(it,ik,is)) &
×
2682
            & + tperpfac*spec(is)%tperp0 / tperpnrm(it,ik,is) &
×
2683
            & * (vperp2(:,iglo)-mom_shift_perp(it,ik,is)) &
×
2684
            & ) * nkxyz(:,it,ik) &
×
2685
            & + ufac*2.*vpa(:,1,iglo)*spec(is)%u0 / unrm(it,ik,is) &
×
2686
            & * ukxyz(:,it,ik) &
×
2687
            )
×
2688
       g(:,2,iglo) = ( &
×
2689
            & ( dfac*spec(is)%dens0 / nnrm(it,ik,is) &
×
2690
            & + tparfac*spec(is)%tpar0 / tparanrm(it,ik,is) &
×
2691
            & * (vpa(:,2,iglo)**2-mom_shift_para(it,ik,is)) &
×
2692
            & + tperpfac*spec(is)%tperp0 / tperpnrm(it,ik,is) &
×
2693
            & * (vperp2(:,iglo)-mom_shift_perp(it,ik,is)) &
×
2694
            & ) * nkxyz(:,it,ik) &
×
2695
            & + ufac*2.*vpa(:,2,iglo)*spec(is)%u0 / unrm(it,ik,is) &
×
2696
            & * ukxyz(:,it,ik) &
×
2697
            )
×
2698

2699
       g_eq(:,1,iglo) = ( &
×
2700
            & ( dfac*spec(is)%dens0 / nnrm(it,ik,is) &
×
2701
            & + tparfac*spec(is)%tpar0 / tparanrm(it,ik,is) &
×
2702
            & * (vpa(:,1,iglo)**2-mom_shift_para(it,ik,is)) &
×
2703
            & + tperpfac*spec(is)%tperp0 / tperpnrm(it,ik,is) &
×
2704
            & * (vperp2(:,iglo)-mom_shift_perp(it,ik,is)) &
×
2705
            & ) * nkxyz_eq(:,it,ik) &
×
2706
            & + ufac*2.*vpa(:,1,iglo)*spec(is)%u0 / unrm(it,ik,is) &
×
2707
            & * ukxyz_eq(:,it,ik) &
×
2708
            )
×
2709
       g_eq(:,2,iglo) = ( &
×
2710
            & ( dfac*spec(is)%dens0 / nnrm(it,ik,is) &
×
2711
            & + tparfac*spec(is)%tpar0 / tparanrm(it,ik,is) &
×
2712
            & * (vpa(:,2,iglo)**2-mom_shift_para(it,ik,is)) &
×
2713
            & + tperpfac*spec(is)%tperp0 / tperpnrm(it,ik,is) &
×
2714
            & * (vperp2(:,iglo)-mom_shift_perp(it,ik,is)) &
×
2715
            & ) * nkxyz_eq(:,it,ik) &
×
2716
            & + ufac*2.*vpa(:,2,iglo)*spec(is)%u0 / unrm(it,ik,is) &
×
2717
            & * ukxyz_eq(:,it,ik) &
×
2718
            )
×
2719
    end do
2720

2721
    deallocate(nnrm,unrm,tparanrm,tperpnrm)
×
2722
    deallocate(g_eq)
×
2723

2724
    if(allocated(mom_coeff)) deallocate(mom_coeff)
×
2725
    if(allocated(mom_shift_para)) deallocate(mom_shift_para)
×
2726
    if(allocated(mom_shift_perp)) deallocate(mom_shift_perp)
×
2727

2728
    ! now store the actual g in gnew
2729
    call copy(g, gnew)
×
2730

2731
    !! check
2732
    if(debug.and.proc0) write(6,*) 'check'
2733
    if(input_check_recon) then
×
2734

2735
       allocate(phi(-ntgrid:ntgrid,nakx,naky))
×
2736
       allocate(apar(-ntgrid:ntgrid,nakx,naky))
×
2737
       allocate(bpar(-ntgrid:ntgrid,nakx,naky))
×
2738

2739
       call get_init_field(phi,apar,bpar)
×
2740

2741
       if(nakx==1 .and. naky==1) then ! grid_option = single case
×
2742
          if(proc0) then
×
2743
             write(6,'(" phi  = ",2e25.17)') &
2744
                  & real(phi (0,1,1)),aimag(phi (0,1,1))
×
2745
             write(6,'(" apar = ",2e25.17)') &
2746
                  & real(apar(0,1,1)),aimag(apar(0,1,1))
×
2747
             write(6,'(" bpar = ",2e25.17)') &
2748
                  & real(bpar(0,1,1)),aimag(bpar(0,1,1))
×
2749
          endif
2750
       else
2751
          if(nx>nakx) then
×
2752
             nnx=nx
×
2753
          else ! nx=nakx=1
2754
             nnx=(3*nakx+1)/2
×
2755
          endif
2756
          if(ny>naky) then
×
2757
             nny=ny
×
2758
          else ! ny=naky=1
2759
             nny=3*naky
×
2760
          endif
2761
          allocate(phixy(nnx,nny,-ntgrid:ntgrid))
×
2762
          allocate(aparxy(nnx,nny,-ntgrid:ntgrid))
×
2763
          allocate(bparxy(nnx,nny,-ntgrid:ntgrid))
×
2764

2765
          allocate(by(-ntgrid:ntgrid,nakx,naky))
×
2766
          allocate(byxy(nnx,nny,-ntgrid:ntgrid))
×
2767

2768
          call transform2(phi,phixy,nny,nnx)
×
2769
          call transform2(apar,aparxy,nny,nnx)
×
2770
          call transform2(bpar,bparxy,nny,nnx)
×
2771
          do it=1,nakx
×
2772
             by(:,it,:)=-zi*akx(it)*apar(:,it,:)
×
2773
          end do
2774
          call transform2(by,byxy,nny,nnx)
×
2775

2776
          if(proc0) then
×
2777
             write(6,'(" phi : mode=",2i4," amp=",e25.17)') &
2778
                  & eq_mode_n,0, &
×
2779
                  & real(phi (0,eq_mode_n+1,1))
×
2780
             write(6,'(" apar: mode=",2i4," amp=",e25.17)') &
2781
                  & eq_mode_u,0, &
×
2782
                  & real(apar(0,eq_mode_u+1,1))
×
2783
             write(6,'(" bpar: mode=",2i4," amp=",e25.17)') &
2784
                  & eq_mode_n,0, &
×
2785
                  & real(bpar(0,eq_mode_n+1,1))
×
2786

2787
             call open_output_file(unit, '.check_field.dat')
×
2788
             write(unit,'(a1,1x,5a20)') '#','x','y','phi','apar','bpar','by'
×
2789
             do it=1,nx+1
×
2790
                i=mod(it-1,nx)+1
×
2791
                do ik=1,ny+1
×
2792
                   j=mod(ik-1,ny)+1
×
2793
                   write(unit,'(2x,6d20.12)') lx/nx*(it-1),ly/ny*(ik-1), &
×
2794
                        & phixy(i,j,0),aparxy(i,j,0),bparxy(i,j,0),byxy(i,j,0)
×
2795
                end do
2796
                write(unit,*)
×
2797
             end do
2798
             call close_output_file(unit)
×
2799
          endif
2800
       endif
2801
    endif
2802

2803
    deallocate(phi,apar,bpar)
×
2804
    if(allocated(phixy)) deallocate(phixy)
×
2805
    if(allocated(aparxy)) deallocate(aparxy)
×
2806
    if(allocated(bparxy)) deallocate(bparxy)
×
2807
    if(allocated(by)) deallocate(by)
×
2808
    if(allocated(byxy)) deallocate(byxy)
×
2809

2810
  contains
2811
    !> FIXME : Add documentation    
2812
    function get_xmax(xguess) result(xsol)
×
2813
      implicit none
2814
      real :: xsol
2815
      real, intent(in) :: xguess
2816
      real, parameter :: tol=1.e-20
2817
      real :: xold
2818
      integer :: i
2819
      integer, parameter :: itmax = 1000
2820
      xold=xguess
×
2821
      do i=1,itmax
×
2822
         xsol=xold-f(xold)/fprime(xold)
×
2823
         if(abs(xsol-xold) > tol) then
×
2824
            xold=xsol
×
2825
         else
2826
            return
×
2827
         endif
2828
      end do
2829
    end function get_xmax
×
2830

2831
    !> FIXME : Add documentation    
2832
    function f(x)
×
2833
      implicit none
2834
      real :: f
2835
      real, intent(in) :: x
2836
      real :: xa, xl1, xl2
2837
      xa=(x-.5*lx)/prof_width
×
2838
      xl1=2.*pi/lx*x
×
2839
      xl2=xl1-2.*pi
×
2840

2841
      f= &
2842
           & 2./prof_width**2*(cosh(2.*xa)-2.)/cosh(xa)**4* & ! f''
2843
           & (tanh(xl1)**2+tanh(xl2)**2-tanh(2.*pi)**2) & ! g
2844
           & + 2. * &
2845
           & (-2./prof_width)*sinh(xa)/cosh(xa)**3* & ! f'
2846
           & 4.*pi/lx*(sinh(xl1)/cosh(xl1)**3+sinh(xl2)/cosh(xl2)**3) & ! g'
2847
           & + &
2848
           & 1./cosh(xa)**2* & ! f
2849
           & 8.*(pi/lx)**2*((2.-cosh(2.*xl1))/cosh(xl1)**4 & ! g''
2850
           &               +(2.-cosh(2.*xl2))/cosh(xl2)**4)
×
2851

2852
    end function f
×
2853

2854
    !> FIXME : Add documentation
2855
    function fprime(x)
×
2856
      implicit none
2857
      real :: fprime
2858
      real, intent(in) :: x
2859
      real :: xa, xl1, xl2
2860
      xa=(x-.5*lx)/prof_width
×
2861
      xl1=2.*pi/lx*x
×
2862
      xl2=xl1-2.*pi
×
2863

2864
      fprime = &
2865
           & 8./prof_width**3*(2.*sinh(xa)-sinh(xa)**3)/cosh(xa)**5* & ! f''' 
2866
           & (tanh(xl1)**2+tanh(xl2)**2-tanh(2.*pi)**2) & ! g
2867
           & + 3. * &
2868
           & 2./prof_width**2*(cosh(2.*xa)-2.)/cosh(xa)**4* & ! f''
2869
           & 4.*pi/lx*(sinh(xl1)/cosh(xl1)**3+sinh(xl2)/cosh(xl2)**3) & ! g'
2870
           & + 3. * &
2871
           & (-2./prof_width)*sinh(xa)/cosh(xa)**3* & ! f'
2872
           & 8.*(pi/lx)**2*((2.-cosh(2.*xl1))/cosh(xl1)**4 & ! g''
2873
           &               +(2.-cosh(2.*xl2))/cosh(xl2)**4) &
2874
           & + &
2875
           & 1./cosh(xa)**2* & ! f
2876
           & (-64.)*(pi/lx)**3 * ( & ! g'''
2877
           & (2.*sinh(xl1)-sinh(xl1)**3)/cosh(xl1)**5 + &
2878
           & (2.*sinh(xl2)-sinh(xl2)**3)/cosh(xl2)**5 )
×
2879
    end function fprime
×
2880

2881
  end subroutine ginit_recon3
2882

2883
  !> Restore `g` from restart files. Note that the timestep and simulation time
2884
  !> are restored by [[read_t0_from_restart_file]]
2885
  subroutine ginit_restart_many
×
2886
    use dist_fn_arrays, only: g, gnew
2887
    use fields_arrays, only: phi, apar, bpar, phinew, aparnew, bparnew
2888
    use gs2_save, only: gs2_restore
2889
    use run_parameters, only: has_phi, has_apar, has_bpar
2890
    use array_utils, only: copy, zero_array
2891
    implicit none
2892
    call gs2_restore (g, scale, has_phi, has_apar, has_bpar)
×
2893
    call copy(g, gnew)
×
2894
    call copy(phinew, phi) ; call copy(aparnew, apar) ; call copy(bparnew, bpar)
×
2895
  end subroutine ginit_restart_many
×
2896

2897
  !> Uses the restart files written by the eigensolver. File to read is set by
2898
  !> [[init_g_knobs:restart_eig_id]]
2899
  subroutine ginit_restart_eig
×
2900
    use dist_fn_arrays, only: g, gnew
2901
    use fields_arrays, only: phi, apar, bpar, phinew, aparnew, bparnew
2902
    use gs2_save, only: gs2_restore
2903
    use run_parameters, only: has_phi, has_apar, has_bpar
2904
    use array_utils, only: copy, zero_array
2905
    implicit none
2906
    character(len=20) :: restart_unique_string
2907
    write(restart_unique_string,'(".eig_",I0)') restart_eig_id
×
2908
    call gs2_restore (g, scale, has_phi, has_apar, has_bpar, fileopt=restart_unique_string)
×
2909
    call copy(g, gnew)
×
2910
    call copy(phinew, phi) ; call copy(aparnew, apar) ; call copy(bparnew, bpar)
×
2911
  end subroutine ginit_restart_eig
×
2912

2913
  !> Restores `g` from restart files _on top of_ a background from [[ginit_noise]].
2914
  !>
2915
  !> Note that this doesnt set `phi`, `apar`, `bpar` -- is this correct?
2916
  subroutine ginit_restart_small
×
2917
    use dist_fn_arrays, only: g, gnew
2918
    use gs2_save, only: gs2_restore
2919
    use run_parameters, only: has_phi, has_apar, has_bpar
2920
    use array_utils, only: copy, zero_array
2921
    implicit none
2922
    call ginit_noise
×
2923
    call gs2_restore (g, scale, has_phi, has_apar, has_bpar)
×
2924
    g = g + gnew
×
2925
    call copy(g, gnew)
×
2926
  end subroutine ginit_restart_small
×
2927

2928
  !> Similar to `"small"`, restores fields from restart files _on top of_ a
2929
  !> random background.
2930
  !>
2931
  !> @Todo this starts with a reduced functionality version of ginit_noise
2932
  !> followed by ginit_restart_many (effectively). This is therefore a reduced
2933
  !> functionality version of ginit_restart_small and we can probably just drop this?
2934
  subroutine ginit_restart_smallflat
×
2935
    use gs2_save, only: gs2_restore
2936
    use species, only: spec
2937
    use theta_grid, only: ntgrid 
2938
    use kt_grids, only: naky, ntheta0, aky, enforce_reality
2939
    use le_grids, only: forbid
2940
    use dist_fn_arrays, only: g, gnew
2941
    use gs2_layouts, only: g_lo, ik_idx, it_idx, il_idx, is_idx
2942
    use run_parameters, only: has_phi, has_apar, has_bpar
2943
    use ran, only: ranf
2944
    use array_utils, only: copy, zero_array
2945
    use warning_helpers, only: is_zero
2946
    implicit none
2947
    complex, dimension (-ntgrid:ntgrid,ntheta0,naky) :: phi
×
2948
    real :: a, b
2949
    integer :: iglo, ik, it, il, is
2950

2951
    do it = 1, ntheta0
×
2952
       do ik = 1, naky
×
2953
          a = ranf()-0.5
×
2954
          b = ranf()-0.5
×
2955
          phi(:,it,ik) = cmplx(a,b)
×
2956
       end do
2957
    end do
2958

2959
    if (naky > 1 .and. is_zero(aky(1))) phi(:,:,1) = phi(:,:,1) * zf_init
×
2960
    if (enforce_reality) call apply_reality(phi)
×
2961

2962
    do iglo = g_lo%llim_proc, g_lo%ulim_proc
×
2963
       ik = ik_idx(g_lo,iglo)
×
2964
       it = it_idx(g_lo,iglo)
×
2965
       il = il_idx(g_lo,iglo)
×
2966
       is = is_idx(g_lo,iglo)
×
2967
       g(:,1,iglo) = -phi(:,it,ik)*spec(is)%z*phiinit
×
2968
       where (forbid(:,il)) g(:,1,iglo) = 0.0
×
2969
       g(:,2,iglo) = g(:,1,iglo)
×
2970
    end do
2971
    call copy(g, gnew)
×
2972

2973
    call gs2_restore (g, scale, has_phi, has_apar, has_bpar)
×
2974
    g = g + gnew
×
2975
    call copy(g, gnew)
×
2976
  end subroutine ginit_restart_smallflat
×
2977

2978
  !> Restart but set all non-zonal components \((k_y \ne 0)\) of the potential
2979
  !> and the distribution function to 0. Noise can be added to these other
2980
  !> components by setting [[init_g_knobs:phiinit]] > 0. The size of the zonal
2981
  !> flows can be adjusted using [[init_g_knobs:zf_init]].
2982
  !>
2983
  !> Author EGH
2984
  subroutine ginit_restart_zonal_only
×
2985
    use gs2_save, only: gs2_restore
2986
    use kt_grids, only: naky, ntheta0, aky
2987
    use dist_fn_arrays, only: g, gnew
2988
    use gs2_layouts, only: g_lo, ik_idx, it_idx, il_idx, is_idx
2989
    use fields_arrays, only: phinew
2990
    use run_parameters, only: has_phi, has_apar, has_bpar
2991
    use array_utils, only: copy, zero_array
2992
    use warning_helpers, only: is_zero
2993
    implicit none
2994
    integer :: iglo, ik, it, il, is
2995

2996
    !  Load phi and g from the restart file
2997
    call gs2_restore (g, scale, has_phi, has_apar, has_bpar)
×
2998
    
2999
    ! Set all non-zonal components of phi to 0
3000
    do it = 1, ntheta0
×
3001
       do ik = 2, naky ! Starting at 2 is the crucial bit!
×
3002
          phinew(:,it,ik) = cmplx(0.0,0.0)
×
3003
       end do
3004
    end do
3005
    
3006
    ! Allow adjustment of the size of the zonal flows via the input parameter zf_init
3007
    if (naky > 1 .and. is_zero(aky(1))) phinew(:,:,1) = phinew(:,:,1) * zf_init
×
3008
    
3009
    do iglo = g_lo%llim_proc, g_lo%ulim_proc
×
3010
       ik = ik_idx(g_lo,iglo)
×
3011
       it = it_idx(g_lo,iglo)
×
3012
       il = il_idx(g_lo,iglo)
×
3013
       is = is_idx(g_lo,iglo)
×
3014
       if (ik > 1) g(:, :, iglo) = 0.0
×
3015
    end do
3016

3017
    ! If phiinit > 0, add some noise
3018
    if (phiinit >  epsilon(0.0)) then 
×
3019
      call ginit_noise
×
3020
      g = g + gnew
×
3021
    end if
3022
    call copy(g, gnew)
×
3023
  end subroutine ginit_restart_zonal_only
×
3024

3025
  !> Restart but remove the zonal flow (ky = 0) component upon restarting.
3026
  !>
3027
  !> Author: FvW (copy of EGH code)
3028
  subroutine ginit_restart_no_zonal
×
3029
    use gs2_save, only: gs2_restore
3030
    use dist_fn_arrays, only: g, gnew
3031
    use gs2_layouts, only: g_lo, ik_idx, it_idx, il_idx, is_idx
3032
    use fields_arrays, only: phinew
3033
    use run_parameters, only: has_phi, has_apar, has_bpar
3034
    use array_utils, only: copy
3035
    implicit none
3036
    integer :: iglo, ik, it, il, is
3037

3038
    !Load phi and g from the restart file
3039
    call gs2_restore (g, scale, has_phi, has_apar, has_bpar)
×
3040
    
3041
    !Set zonal component of phi to 0
3042
    phinew(:,:,1) = cmplx(0.0,0.0)
×
3043
    
3044
    !Set zonal components of g to zero using phi
3045
    
3046
    do iglo = g_lo%llim_proc, g_lo%ulim_proc
×
3047
       ik = ik_idx(g_lo,iglo)
×
3048
       it = it_idx(g_lo,iglo)
×
3049
       il = il_idx(g_lo,iglo)
×
3050
       is = is_idx(g_lo,iglo)
×
3051
       if (ik == 1) g(:, :, iglo) = 0.0
×
3052
    end do
3053
    call copy(g, gnew)
×
3054
  end subroutine ginit_restart_no_zonal
×
3055

3056
  !> The stationary mode test case is a method of testing the geometry
3057
  !! implementation by initializing the distribution function in a particular way
3058
  !! For collisionless runs with ky=0, we expect the solution to be
3059
  !! time-independent (see section 3.3.1 of Ball MIT Masters thesis)
3060
  !!
3061
  !! JRB
3062
  subroutine ginit_stationary_mode
×
3063
    use species, only: spec, nspec
3064
    use theta_grid, only: ntgrid, theta, bmag, rhoc
3065
    use kt_grids, only: akx
3066
    use dist_fn_arrays, only: g, gnew, vpa, aj0
3067
    use gs2_layouts, only: g_lo, it_idx, is_idx
3068
    use geometry, only : surf, geom !< Should be Rplot from theta_grid instead of geom%Rpos?
3069
    use array_utils, only: copy
3070
    use constants, only: zi
3071
    implicit none
3072

3073
    complex, dimension (-ntgrid:ntgrid) :: phi
×
3074
    integer :: iglo
3075
    integer :: ig, ik, it, is
3076

3077
    real, dimension (-ntgrid:ntgrid) :: numeratorSum
×
3078
    real :: denominatorSum, qinp, R_geo
3079

3080
    numeratorSum(:) = 0 ; denominatorSum = 0
×
3081
    qinp = surf%q ; R_geo = surf%r_geo
×
3082
    it = 1
×
3083
    ik = 1
×
3084
    do is = 1, nspec
×
3085
      do ig = -ntgrid, ntgrid
×
3086
        numeratorSum(ig) = numeratorSum(ig) + ((spec(is)%z)**2)*spec(is)%dens*exp(-((spec(is)%mass*spec(is)%temp)/(4*(spec(is)%z)**2))*((qinp/rhoc)*akx(it)*geom%Rpos(rhoc,theta(ig)))**2)
×
3087
      end do
3088
      denominatorSum = denominatorSum + (spec(is)%z)**2*spec(is)%dens/spec(is)%temp
×
3089
    end do
3090

3091
    phi(:) = numeratorSum(:)/denominatorSum
×
3092

3093
    do iglo = g_lo%llim_proc, g_lo%ulim_proc
×
3094
       it = it_idx(g_lo,iglo)
×
3095
       is = is_idx(g_lo,iglo)
×
3096

3097
       g(:,1,iglo) = spec(is)%z*exp(-zi*(qinp/rhoc)*akx(it)*vpa(:,1,iglo)*R_geo*(spec(is)%mass/(spec(is)%z*bmag(:)))) &
×
3098
                   - (spec(is)%z/spec(is)%temp)*aj0(:,iglo)*phi(:)
×
3099
       g(:,2,iglo) = spec(is)%z*exp(-zi*(qinp/rhoc)*akx(it)*vpa(:,2,iglo)*R_geo*(spec(is)%mass/(spec(is)%z*bmag(:)))) &
×
3100
                   - (spec(is)%z/spec(is)%temp)*aj0(:,iglo)*phi(:)
×
3101
    end do
3102
    call copy(g, gnew)
×
3103
  end subroutine ginit_stationary_mode
×
3104

3105
  !> Sets g to a constant value everywhere except zonal component which is 0
3106
  !> Default initial conditions for CGYRO
3107
  !>
3108
  !> if phiinit>0:
3109
  !>     g(ky!=0) = constant
3110
  !> else:
3111
  !>     g(ky!=0) = constant/n
3112
  !>
3113
  !> if zfinit!=0:
3114
  !>     g(ky==0) = constant * exp(-|kx|/max(kx))
3115
  !> else:
3116
  !>     g(ky==0) = 0
3117
  !>
3118
  !> Set by having 'ginit_option' = cgyro
3119
  !> Equivalent CGYRO parameters achieved by setting
3120
  !>    GS2   =    CGYRO
3121
  !> phiinit = AMP / sqrt(2)
3122
  !> zfinit   = AMP0 / AMP
3123
  !>
3124
  !> By default AMP0=0 and AMP=0.1 in CGYRO
3125
  !>
3126
  !> Potential issue in AMP=0 in CGYRO due to zfinit defn
3127
  !>
3128
  !> Author: BSP (copy of EGH code)
3129
  subroutine ginit_cgyro
×
3130
    use mp, only: proc0
3131
    use le_grids, only: forbid
3132
    use kt_grids, only: akx, aky
3133
    use dist_fn_arrays, only: g, gnew
3134
    use gs2_layouts, only: g_lo, ik_idx, it_idx, il_idx
3135
    use array_utils, only: copy
3136
    use warning_helpers, only: is_zero
3137
    implicit none
3138
    integer :: iglo
3139
    integer :: ik, it, il, in
3140
    real :: arg, kxrange
3141

3142
    kxrange = maxval(akx) - minval(akx)
×
3143

3144
    if(debug.and.proc0) write(*,*) 'Entering CGYRO def'
3145
    do iglo = g_lo%llim_proc, g_lo%ulim_proc
×
3146
       ik = ik_idx(g_lo,iglo)
×
3147
       it = it_idx(g_lo,iglo)
×
3148
       il = il_idx(g_lo,iglo)
×
3149
       if (is_zero(aky(ik))) then
×
3150
          arg = abs(akx(it))/ kxrange
×
3151
          g(:,1,iglo) = zf_init * abs(phiinit) * exp(-arg)
×
3152
       else
3153
          ! Ensure we don't end up with in = 0. This shouldn't
3154
          ! be needed for flux tube (box) simulations as ik == 1
3155
          ! would correspond to the zonal mode, handled in the
3156
          ! earlier branch.
3157
          if (phiinit < 0.0 .and. ik > 1) then
×
3158
             in = ik - 1
×
3159
          else
3160
             in = 1
×
3161
          end if
3162
          g(:,1,iglo) = abs(phiinit) / in**2
×
3163
       end if
3164

3165
       where (forbid(:,il)) g(:,1,iglo) = 0.0
×
3166
       g(:,2,iglo) = g(:,1,iglo)
×
3167
    end do
3168
    call copy(g, gnew)
×
3169
  end subroutine ginit_cgyro
×
3170

3171
  !> Construct the initial condition from a sum of sine waves scaled
3172
  !> with random amplitude up to phiinit (ky > 0) or zf_init (ky ==
3173
  !> 0). Use mode numbers up to minimum of max_mode or last resolved
3174
  !> wave (i.e. ntheta/8).
3175
  !>
3176
  !> A sine wave is selected in order to ensure that the initial
3177
  !> distribution satisfies the parallel boundary conditions
3178
  !> (i.e. that either gnew or h = 0).
3179
  subroutine ginit_random_sine
×
3180
    use theta_grid, only: ntgrid, ntheta, theta
3181
    use kt_grids, only: naky, ntheta0, aky, enforce_reality, akx
3182
    use le_grids, only: forbid
3183
    use dist_fn_arrays, only: g, gnew
3184
    use gs2_layouts, only: g_lo, ik_idx, it_idx, il_idx, is_idx
3185
    use constant_random, only: init_constant_random, finish_constant_random
3186
    use mp, only: proc0, broadcast
3187
    use array_utils, only: copy, zero_array
3188
    use warning_helpers, only: is_zero
3189
    use species, only: spec
3190
    implicit none
3191
    complex, dimension (-ntgrid:ntgrid,ntheta0,naky) :: phi
×
3192
    real, dimension(-ntgrid:ntgrid) :: sin_theta_mode
×
3193
    real :: a, b
3194
    real, parameter :: sqrt_two = sqrt(2.0)
3195
    integer :: iglo, ik, it, il, imode, the_max_mode
3196

3197
    call zero_array(phi)
×
3198

3199
    ! Make sure the max mode is at least 1, but no bigger than the smaller
3200
    ! of the input max_mode and ntheta/8
3201
    the_max_mode = max(1, min(max_mode, ntheta/8))
×
3202

3203
    ! We choose to only initialise on proc0 and then broadcast to make
3204
    ! sure that all procs have the same values. If done on a processor
3205
    ! by processor basis, then it's possible that different processors
3206
    ! would produce different values. This could lead to a non-Maxwellian
3207
    ! perturbation (i.e. something not constant in our velocity space).
3208
    if (proc0) then
×
3209
       if (constant_random_flag) call init_constant_random
×
3210
       ! Here we go from 2*min_mode (min_mode == 1) to 2*the_max_mode
3211
       ! but then divide imode by two in order to allow us to capture
3212
       ! n + 1/2 mode numbers and hence provide an even parity
3213
       ! contribution to the initial condition.
3214
       do imode = 2, the_max_mode*2
×
3215
          sin_theta_mode = sin(imode*(theta-theta(-ntgrid))/2.0)
×
3216
          do ik = 1, naky
×
3217
             do it = 1, ntheta0
×
3218
                call set_a_and_b_uniform_random_weighting(a, b)
×
3219
                phi(:, it, ik) = phi(:, it, ik) + cmplx(a*sin_theta_mode, b*sin_theta_mode)
×
3220
             end do
3221
          end do
3222
       end do
3223
       if (constant_random_flag) call finish_constant_random
×
3224
       if (enforce_reality) call apply_reality(phi)
×
3225
    end if
3226

3227
    call broadcast(phi)
×
3228

3229
    ! Now set the distribution function from "phi".
3230
    do iglo = g_lo%llim_proc, g_lo%ulim_proc
×
3231
       ik = ik_idx(g_lo, iglo)
×
3232
       it = it_idx(g_lo, iglo)
×
3233
       il = il_idx(g_lo, iglo)
×
3234
       if (is_zero(aky(ik))) then
×
3235
          g(:, 1, iglo) = zf_init * phiinit * phi(:, it, ik)
×
3236

3237
          ! Zero the ky=kx=0 mode
3238
          if (is_zero(akx(it))) g(:, 1, iglo) = 0.0
×
3239
       else
3240
          g(:, 1, iglo) = phiinit * phi(:, it, ik)
×
3241
       end if
3242
       g(:, 1, iglo) = g(:, 1, iglo) * spec(is_idx(g_lo, iglo))%z
×
3243
       where (forbid(:, il)) g(:, 1, iglo) = 0.0
×
3244
       g(:, 2, iglo) = g(:, 1, iglo)
×
3245
    end do
3246
    call copy(g, gnew)
×
3247
  contains
3248
    !> Real and imaginary weights are uniformly distributed between
3249
    !> -1/sqrt(2) and 1/sqrt(2) using either the main random number
3250
    !> generator or the constant random one.
3251
    subroutine set_a_and_b_uniform_random_weighting(a, b)
×
3252
      use ran, only: ranf
3253
      use constant_random, only: constant_ranf=>ranf
3254
      implicit none
3255
      real, intent(out) :: a, b
3256
      if (constant_random_flag) then
×
3257
         a = (constant_ranf() - 0.5)
×
3258
         b = (constant_ranf() - 0.5)
×
3259
      else
3260
         a = (ranf() - 0.5)
×
3261
         b = (ranf() - 0.5)
×
3262
      end if
3263
      a = a * sqrt_two
×
3264
      b = b * sqrt_two
×
3265
    end subroutine set_a_and_b_uniform_random_weighting
×
3266

3267
  end subroutine ginit_random_sine
3268

3269
  !> Initialise the distribution function to a constant but satisfying
3270
  !> forbidden regions. Can scale the zonal component separately as
3271
  !> usual.
3272
  subroutine ginit_constant
×
3273
    use kt_grids, only: aky, akx
3274
    use le_grids, only: forbid
3275
    use dist_fn_arrays, only: g, gnew
3276
    use gs2_layouts, only: g_lo, ik_idx, it_idx, il_idx, is_idx
3277
    use array_utils, only: copy
3278
    use warning_helpers, only: is_zero
3279
    use species, only: spec
3280
    implicit none
3281
    integer :: iglo, ik, it, il
3282

3283
    do iglo = g_lo%llim_proc, g_lo%ulim_proc
×
3284
       ik = ik_idx(g_lo, iglo)
×
3285
       it = it_idx(g_lo, iglo)
×
3286
       il = il_idx(g_lo, iglo)
×
3287
       if (is_zero(aky(ik))) then
×
3288
          g(:, 1, iglo) = zf_init * phiinit
×
3289

3290
          ! Zero the ky=kx=0 mode
3291
          if (is_zero(akx(it))) g(:, 1, iglo) = 0.0
×
3292
       else
3293
          g(:, 1, iglo) = phiinit
×
3294
       end if
3295
       g(:, 1, iglo) = g(:, 1, iglo) * spec(is_idx(g_lo, iglo))%z
×
3296
       where (forbid(:, il)) g(:, 1, iglo) = 0.0
×
3297
       g(:, 2, iglo) = g(:, 1, iglo)
×
3298
    end do
3299
    call copy(g, gnew)
×
3300
  end subroutine ginit_constant
×
3301

3302
  !> Helper function for common approach to setting g from a passed phi array
3303
  subroutine set_g_from_moment_facs(g, phiinit, phi, dfac_species_weight, &
×
3304
       ufac_species_weight, use_even, do_reality)
3305
    use gs2_layouts, only: g_lo, ik_idx, it_idx, il_idx, is_idx
3306
    use theta_grid, only: ntgrid, theta
3307
    use kt_grids, only: naky, ntheta0
3308
    use dist_fn_arrays, only: vpa, vperp2
3309
    use le_grids, only: forbid
3310
    use species, only: spec, nspec
3311
    use constants, only: zi
3312
    complex, dimension(-ntgrid:, :, g_lo%llim_proc:), intent(in out) :: g
3313
    real, intent(in) :: phiinit ! Shadows module level
3314
    complex, dimension (-ntgrid:ntgrid,ntheta0,naky), intent(in out) :: phi
3315
    logical, intent(in) :: dfac_species_weight, ufac_species_weight, use_even, do_reality
3316
    complex, dimension (-ntgrid:ntgrid,ntheta0,naky) :: odd
×
3317
    real, dimension(-ntgrid:ntgrid) :: dfac, ufac, tparfac, tperpfac, ct, st, c2t, s2t
×
3318
    integer :: iglo, ik, it, il, is
3319
    real, dimension(nspec) :: dfac_weight, ufac_weight
×
3320
    if (use_even) then
×
3321
       ct = cos(theta) ; st = sin(theta)
×
3322
       c2t = cos(2.*theta) ; s2t = sin(2.*theta)
×
3323
    else
3324
       ct = sin(theta) ; st = cos(theta)
×
3325
       c2t = sin(2.*theta) ; s2t = cos(2.*theta)
×
3326
    end if
3327

3328
    dfac     = den0   + den1 * ct + den2 * c2t
×
3329
    ufac     = upar0  + upar1* st + upar2* s2t
×
3330
    tparfac  = tpar0  + tpar1* ct + tpar2* c2t
×
3331
    tperpfac = tperp0 + tperp1*ct + tperp2*c2t
×
3332

3333
    dfac_weight = 1.0
×
3334
    if (dfac_species_weight) dfac_weight = spec%dens0
×
3335
    ufac_weight = 1.0
×
3336
    if (ufac_species_weight) ufac_weight = spec%u0
×
3337

3338
    odd = zi * phi
×
3339

3340
    ! reality condition for k_theta = 0 component:
3341
    if (do_reality) then
×
3342
       call apply_reality(phi)
×
3343
       call apply_reality(odd)
×
3344
    end if
3345

3346
    !$OMP PARALLEL DO DEFAULT(none) &
3347
    !$OMP PRIVATE(iglo, ik, it, il, is) &
3348
    !$OMP SHARED(g_lo, g, phiinit, dfac, dfac_weight, phi, &
3349
    !$OMP ufac, ufac_weight, vpa, odd, tparfac, tperpfac, vperp2, forbid) &
3350
    !$OMP SCHEDULE(static)
3351
    do iglo = g_lo%llim_proc, g_lo%ulim_proc
×
3352
       ik = ik_idx(g_lo,iglo)
×
3353
       it = it_idx(g_lo,iglo)
×
3354
       il = il_idx(g_lo,iglo)
×
3355
       is = is_idx(g_lo,iglo)
×
3356

3357
       g(:,1,iglo) = phiinit* &
×
3358
            ( dfac*dfac_weight(is)                 * phi(:,it,ik) &
×
3359
            + 2*ufac*ufac_weight(is)*vpa(:,1,iglo) * odd(:,it,ik) &
×
3360
            + tparfac*(vpa(:,1,iglo)**2-0.5)       * phi(:,it,ik) &
×
3361
            +tperpfac*(vperp2(:,iglo)-1.)          * phi(:,it,ik))
×
3362
       where (forbid(:,il)) g(:,1,iglo) = 0.0
×
3363

3364
       g(:,2,iglo) = phiinit* &
×
3365
            ( dfac*dfac_weight(is)                 * phi(:,it,ik) &
×
3366
            + 2*ufac*ufac_weight(is)*vpa(:,2,iglo) * odd(:,it,ik) &
×
3367
            + tparfac*(vpa(:,2,iglo)**2-0.5)       * phi(:,it,ik) &
×
3368
            +tperpfac*(vperp2(:,iglo)-1.)          * phi(:,it,ik))
×
3369
       where (forbid(:,il)) g(:,2,iglo) = 0.0
×
3370
    end do
3371
    !$OMP END PARALLEL DO
3372
  end subroutine set_g_from_moment_facs
×
3373

3374
  !> Apply the reality condition to the zonal mode (kx = conj(-kx))
3375
  subroutine apply_reality(field)
×
3376
    use kt_grids, only: ntheta0
3377
    complex, dimension(:, :, :), intent(in out) :: field
3378
    integer :: it
3379
    !$OMP PARALLEL DO DEFAULT(none) &
3380
    !$OMP PRIVATE(it) &
3381
    !$OMP SHARED(ntheta0, field) &
3382
    !$OMP SCHEDULE(static)
3383
    do it = 1, ntheta0 / 2
×
3384
       field(:, it+(ntheta0+1)/2, 1) = conjg(field(:, (ntheta0+1)/2+1-it, 1))
×
3385
    end do
3386
    !$OMP END PARALLEL DO
3387
  end subroutine apply_reality
×
3388

3389
  subroutine do_chop_side_slice(field_slice)
×
3390
    use theta_grid, only: ntgrid
3391
    complex, dimension(-ntgrid:), intent(in out) :: field_slice
3392
    if (chop_side .and. left) field_slice(:-1) = 0.0
×
3393
    if (chop_side .and. .not. left) field_slice(1:) = 0.0
×
3394
  end subroutine do_chop_side_slice
×
3395

3396
  subroutine do_chop_side_full(field)
×
3397
    use theta_grid, only: ntgrid
3398
    complex, dimension(-ntgrid:,:,:), intent(in out) :: field
3399
    if (chop_side .and. left) field(:-1, :, :) = 0.0
×
3400
    if (chop_side .and. .not. left) field(1:, :, :) = 0.0
×
3401
  end subroutine do_chop_side_full
×
3402

3403
  !> FIXME : Add documentation
3404
  subroutine single_initial_kx(phi)
×
3405
    use theta_grid, only: ntgrid
3406
    use kt_grids, only: naky, ntheta0
3407
    use mp, only: mp_abort
3408
    implicit none
3409
    complex, dimension (-ntgrid:ntgrid,ntheta0,naky), intent(inout) :: phi
3410
    integer :: ig, ik, it
3411

3412
    if (ikx_init  < 2 .or. ikx_init > (ntheta0+1)/2) then
×
3413
      call mp_abort("The subroutine single_initial_kx should only be called when 1 < ikx_init < (ntheta0+1)/2")
×
3414
    end if
3415

3416
    do it = 1, ntheta0
×
3417
      if (it /= ikx_init) then
×
3418
         do ik = 1, naky
×
3419
            do ig = -ntgrid, ntgrid
×
3420
               phi(ig,it,ik) = 0.
×
3421
             end do
3422
         end do
3423
       end if
3424
    end do
3425
  end subroutine single_initial_kx
×
3426

3427
  !> FIXME : Add documentation
3428
  subroutine flae (g, gavg)
×
3429
    use species, only: spec, is_electron_species
3430
    use theta_grid, only: ntgrid, field_line_average
3431
    use kt_grids, only: aky
3432
    use gs2_layouts, only: g_lo, is_idx, ik_idx
3433
    use array_utils, only: zero_array
3434
    use warning_helpers, only: is_not_zero
3435
    complex, dimension (-ntgrid:,:,g_lo%llim_proc:), intent (in) :: g
3436
    complex, dimension (-ntgrid:,:,g_lo%llim_proc:), intent (out) :: gavg
3437
    integer :: iglo
3438
    call zero_array(gavg)
×
3439

3440
    !$OMP PARALLEL DO DEFAULT(NONE)&
3441
    !$OMP PRIVATE(iglo) &
3442
    !$OMP SHARED(g_lo, g, gavg, spec, aky) &
3443
    !$OMP SCHEDULE(static)
3444
    do iglo = g_lo%llim_proc, g_lo%ulim_proc
×
3445
       if (.not. is_electron_species(spec(is_idx(g_lo, iglo)))) cycle
×
3446
       if (is_not_zero(aky(ik_idx(g_lo, iglo)))) cycle
×
3447
       gavg(:, 1, iglo) = field_line_average(g(:, 1, iglo))
×
3448
       gavg(:, 2, iglo) = field_line_average(g(:, 2, iglo))
×
3449
    end do
3450
    !$OMP END PARALLEL DO
3451
  end subroutine flae
×
3452

3453
  !> FIXME : Add documentation    
3454
  subroutine finish_init_g
12✔
3455
    implicit none
3456
    initialized = .false.
12✔
3457
  end subroutine finish_init_g
12✔
3458

3459
  !> Returns the value of [[init_g_knobs:restart_dir]]
3460
  function get_restart_dir()
×
3461
    character(len=:), allocatable :: get_restart_dir
3462
    get_restart_dir = restart_dir
×
3463
  end function get_restart_dir
×
3464

3465
  !> Sets the value of the module level restart_dir
3466
  subroutine set_restart_dir(restart_dir_in)
×
3467
    character(len=*), intent(in) :: restart_dir_in
3468
    restart_dir = restart_dir_in
×
3469
  end subroutine set_restart_dir
×
3470

3471
#include "init_g_auto_gen.inc"
3472
end module init_g
×
STATUS · Troubleshooting · Open an Issue · Sales · Support · CAREERS · ENTERPRISE · START FREE · SCHEDULE DEMO
ANNOUNCEMENTS · TWITTER · TOS & SLA · Supported CI Services · What's a CI service? · Automated Testing

© 2026 Coveralls, Inc