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

gyrokinetics / gs2 / 1640171109

24 Jan 2025 07:04PM UTC coverage: 7.915% (-0.03%) from 7.943%
1640171109

push

gitlab-ci

David Dickinson
Merged in experimental/generate_config_collection_module (pull request #1070)

3691 of 46631 relevant lines covered (7.92%)

99785.8 hits per line

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

0.0
/src/fields.f90
1
!> FIXME : Add documentation
2
module fields
3
  use abstract_config, only: abstract_config_type, CONFIG_MAX_NAME_LEN
4
  use text_options, only: text_option
5

6
  implicit none
7

8
  private 
9

10
  public :: init_fields, finish_fields
11
  public :: read_parameters, wnml_fields, check_fields
12
  public :: advance, force_maxwell_reinit
13
  public :: reset_init, set_init_fields
14
  public :: fields_init_response, set_dump_and_read_response
15
  public :: dump_response_to_file
16
  public :: init_fields_parameters
17
  public :: finish_fields_parameters
18
  public :: set_overrides
19
  public :: init_fields_level_1, init_fields_level_2
20
  public :: finish_fields_level_1, finish_fields_level_2
21
  public :: fieldopt_switch, fieldopt_implicit, fieldopt_test, fieldopt_local, fieldopt_gf_local
22

23
  !> Made public for unit tests
24
  public :: fields_pre_init
25
  public :: remove_zonal_flows_switch
26

27
  public :: fields_config_type
28
  public :: set_fields_config
29
  public :: get_fields_config
30
  
31
  ! knobs
32
  integer :: fieldopt_switch
33
  logical :: remove_zonal_flows_switch
34
  logical :: force_maxwell_reinit
35
  integer, parameter :: fieldopt_implicit = 1, fieldopt_test = 2, fieldopt_local = 3, fieldopt_gf_local = 4
36
  logical :: dump_response, read_response
37
  logical :: initialized = .false.
38
  logical :: parameters_read = .false.
39

40
  !EGH made fieldopts module level for overrides
41
  type (text_option), dimension (6), parameter :: fieldopts = &
42
       (/ text_option('default', fieldopt_implicit), &
43
          text_option('implicit', fieldopt_implicit), &
44
          text_option('test', fieldopt_test),&
45
          text_option('local', fieldopt_local),&
46
          text_option('gf_local', fieldopt_gf_local),&
47
          text_option('implicit_local', fieldopt_local)/)
48
  
49
  !> Used to represent the input configuration of fields
50
  type, extends(abstract_config_type) :: fields_config_type
51
     ! namelist : fields_knobs
52
     ! indexed : false
53
     !> Used with `field_option='local'`. If `true` and x/y are
54
     !> distributed then in time advance only update local part of
55
     !> field in operations like `phinew=phinew+phi` etc.
56
     logical :: do_smart_update = .false.
57
     !> Writes files containing the field response matrix after
58
     !> initialisation. This currently works for
59
     !> `field_option='implicit'` or `'local'`.  We write to netcdf
60
     !> files by default but fall back to fortran unformatted (binary)
61
     !> files (which are not really portable) in the absence of
62
     !> netcdf.
63
     logical :: dump_response = .false.
64
     !> Set to true to use an allreduce (on `mp_comm`) in field
65
     !> calculation (`field_option='local'` only) rather than a
66
     !> reduction on a sub-communicator followed by a global
67
     !> broadcast. Typically a little faster than default performance
68
     !> but may depend on MPI implementation.
69
     logical :: field_local_allreduce = .false.
70
     !> Set to `true`, along with [[field_local_allreduce]] and
71
     !> [[layouts_knobs:intspec_sub]] , to replace the allreduce used
72
     !> in the field calculation with an allreduce on a
73
     !> sub-communicator followed by a reduction on a "perpendicular"
74
     !> communicator.  Typically a bit faster than default and scales
75
     !> slightly more efficiently.  Note if this option is active only
76
     !> `proc0` has knowledge of the full field arrays. Other
77
     !> processors know the full field for any supercell (connected
78
     !> x-y domains) for which it has any of the xy indices local in
79
     !> the `g_lo` layout.
80
     logical :: field_local_allreduce_sub = .false.
81
     !> If `true` then use nonblocking collective operations in the
82
     !> [[fields_local]] field calculation. This may or may not
83
     !> improve performance.
84
     logical :: field_local_nonblocking_collectives = .false.
85
     !> Set to `true` when using `field_option='local'` to
86
     !> automatically tune and select the best performing minimum
87
     !> block size (in a single supercell) assigned to a single
88
     !> processor. This can improve performance, but is not guaranteed
89
     !> to.
90
     logical :: field_local_tuneminnrow = .false.
91
     !> The `field_option` variable controls which time-advance
92
     !> algorithm is used for the linear terms. Allowed values are:
93
     !>
94
     !> - 'implicit' Advance linear terms with Kotschenreuther's implicit algorithm.
95
     !> - 'default' Same as 'implicit'.
96
     !> - 'implicit_local' the same as 'local'.
97
     !> - 'local' Same implicit algorithm as 'implicit' but with
98
     !>   different data decomposition (typically much faster for flux
99
     !>   tube runs).
100
     !> - 'gf_local' Same as `'local'` but with `gf_lo` field
101
     !>   decomposition. To use this you also need to set
102
     !>   `gf_lo_integrate= .true.` in [[dist_fn_knobs]] and
103
     !>   `gf_local_fields = .true.` in [[layouts_knobs]].
104
     !> - 'test' Use for debugging.     
105
     character(len = 20) :: field_option = 'default'
106
     !> Set to true to use allgatherv to fetch parts of the field update
107
     !> vector calculated on other procs. When false uses a sum_allreduce
108
     !> instead. This doesn't rely on sub-communicators so should work for
109
     !> any layout and processor count.  Note: This only impacts
110
     !> `field_option='implicit'`
111
     logical :: field_subgath = .false.
112
     !> If `true` then recalculate the fields from the distribution
113
     !> function using [[get_init_field]] when restarting a
114
     !> simulation rather than using the values in the restart file.
115
     !>
116
     !> @todo Consider if this should this go into the reinit namelist.
117
     logical :: force_maxwell_reinit = .true. 
118
     !> Used with `field_option='local'` to set the minimum block size
119
     !> (in a single supercell) assigned to a single processor. Tuning
120
     !> this parameter changes the balance between work
121
     !> parallelisation and communication. As this value is lowered,
122
     !> more communication needs to be done, but more processors get
123
     !> assigned work. This may reduce the time spent in computation
124
     !> at the cost of time spent in communication. The optimal value
125
     !> is likely to depend upon the size of the problem and the
126
     !> number of processors being used. Furthermore it will affect
127
     !> intialisation and advance in different ways. Can be
128
     !> automatically tuned using [[fields_knobs:field_local_tuneminnrow]].
129
     integer :: minnrow = 16
130
     !> Reads files containing the field response matrix and uses to
131
     !> initialise GS2s response matrix rather than using the usual
132
     !> initialisation process.
133
     logical :: read_response = .false.
134
     !> Delete zonal flows at every timestep.
135
     logical :: remove_zonal_flows_switch = .false.
136
     !> Sets location in which to store/look for response dump files.
137
     !> We don't currently check that this location exists before
138
     !> attempting to use it, which could cause problems. The default
139
     !> is to save them in the working directory.
140
     character(len = 256) :: response_dir = ''
141
     !> Allows customisation of the base filename to be used for
142
     !> response files. If not set then we use `run_name` derived
143
     !> from the input file name.
144
     character(len = 256) :: response_file = ''
145
   contains
146
     procedure, public :: read => read_fields_config
147
     procedure, public :: write => write_fields_config
148
     procedure, public :: reset => reset_fields_config
149
     procedure, public :: broadcast => broadcast_fields_config
150
     procedure, public, nopass :: get_default_name => get_default_name_fields_config
151
     procedure, public, nopass :: get_default_requires_index => get_default_requires_index_fields_config
152
  end type fields_config_type
153
  
154
  type(fields_config_type) :: fields_config  
155
contains
156

157
  !> FIXME : Add documentation  
158
  subroutine check_fields(report_unit)
×
159
    use fields_local, only: do_smart_update, minNRow
160
    implicit none
161
    integer, intent(in) :: report_unit
162
    select case (fieldopt_switch)
×
163
    case (fieldopt_implicit)
164
       write (report_unit, fmt="('The field equations will be advanced in time implicitly.')")
×
165
       if(dump_response) write (report_unit, fmt="('The response matrix will be dumped to file.')")
×
166
       if(read_response) write (report_unit, fmt="('The response matrix will be read from file.')")
×
167
    case (fieldopt_test)
168
       write (report_unit, *) 
×
169
       write (report_unit, fmt="('################# WARNING #######################')")
×
170
       write (report_unit, fmt="('The field equations will only be tested.')")
×
171
       write (report_unit, fmt="('THIS IS PROBABLY AN ERROR.')") 
×
172
       write (report_unit, fmt="('################# WARNING #######################')")
×
173
       write (report_unit, *) 
×
174
    case (fieldopt_local)
175
       write (report_unit, fmt="('The field equations will be advanced in time implicitly with decomposition respecting g_lo layout.')")
×
176
       if(dump_response) write (report_unit, fmt="('The response matrix will be dumped to file.')")
×
177
       if(read_response) write (report_unit, fmt="('The response matrix will be read from file.')")
×
178
       write(report_unit, fmt="('Using a min block size of ',I0)") minNrow
×
179
       if(do_smart_update) write(report_unit, fmt="('Using optimised field update.')")
×
180
    case (fieldopt_gf_local)
181
       write (report_unit, fmt="('The field equations will be advanced in time implicitly with decomposition respecting gf_lo layout.')")
×
182
    end select
183
  end subroutine check_fields
×
184

185
  !> FIXME : Add documentation  
186
  subroutine wnml_fields(unit)
×
187
    use fields_local, only: do_smart_update, minNRow
188
    implicit none
189
    integer, intent(in) :: unit
190
    write (unit, *)
×
191
    write (unit, fmt="(' &',a)") "fields_knobs"
×
192
    select case (fieldopt_switch)
×
193
    case (fieldopt_implicit)
194
       write (unit, fmt="(' field_option = ',a)") '"implicit"'
×
195
    case (fieldopt_test)
196
       write (unit, fmt="(' field_option = ',a)") '"test"'
×
197
    case (fieldopt_local)
198
       write (unit, fmt="(' field_option = ',a)") '"local"'
×
199
       write (unit, fmt="(' minNrow = ',I0)") minNrow
×
200
       write (unit, fmt="(' do_smart_update = ',L1)") do_smart_update
×
201
    case (fieldopt_gf_local)
202
       write (unit, fmt="(' field_option = ',a)") '"local gf"'
×
203
    end select
204
    if(dump_response) write (unit, fmt="(' dump_response = ',L1)") dump_response
×
205
    if(read_response) write (unit, fmt="(' read_response = ',L1)") read_response
×
206
    write (unit, fmt="(' /')")
×
207
  end subroutine wnml_fields
×
208

209
  !> FIXME : Add documentation
210
  subroutine set_overrides(opt_ov)
×
211
    use overrides, only: optimisations_overrides_type
212
    use file_utils, only: error_unit
213
    use text_options, only: get_option_value
214
    use fields_local, only: minnrow
215
    use fields_implicit, only: field_subgath
216
    use fields_local, only: do_smart_update
217
    use fields_local, only: field_local_allreduce
218
    use fields_local, only: field_local_allreduce_sub
219
    type(optimisations_overrides_type), intent(in) :: opt_ov
220
    integer :: ierr
221
    if (opt_ov%override_field_option) then
×
222
       ierr = error_unit()
×
223
       call get_option_value &
224
            (opt_ov%field_option, fieldopts, fieldopt_switch, &
225
            ierr, "field_option in set_overrides",.true.)
×
226
    end if
227
    if (opt_ov%override_minnrow) minnrow = opt_ov%minnrow
×
228
    if (opt_ov%override_field_subgath) field_subgath = opt_ov%field_subgath
×
229
    if (opt_ov%override_do_smart_update) do_smart_update = & 
×
230
      opt_ov%do_smart_update
×
231
    if (opt_ov%override_field_local_allreduce) field_local_allreduce = & 
×
232
      opt_ov%field_local_allreduce
×
233
    if (opt_ov%override_field_local_allreduce_sub) field_local_allreduce_sub =& 
×
234
      opt_ov%field_local_allreduce_sub
×
235
  end subroutine set_overrides
×
236

237
  !> Calls all initialisations required for init_fields_implicit/local, 
238
  !! reads parameters and allocates field arrays
239
  subroutine fields_pre_init(fields_config_in)
×
240
    use theta_grid, only: init_theta_grid
241
    use run_parameters, only: init_run_parameters
242
    use dist_fn, only: init_dist_fn, gf_lo_integrate
243
    use antenna, only: init_antenna
244
    use unit_tests, only: debug_message
245
    use kt_grids, only: naky, ntheta0
246
    use mp, only: nproc, proc0
247
    implicit none
248
    type(fields_config_type), intent(in), optional :: fields_config_in    
249
    integer, parameter :: verb=3
250
    
251
    call init_fields_parameters(fields_config_in)
×
252
    call debug_message(verb, "init_fields: init_theta_grid")
×
253
    call init_theta_grid
×
254
    call debug_message(verb, "init_fields: init_run_parameters")
×
255
    call init_run_parameters
×
256
    call debug_message(verb, "init_fields: init_dist_fn")
×
257
    call init_dist_fn
×
258

259
    if(nproc .lt. ntheta0*naky .and. fieldopt_switch .eq. fieldopt_gf_local) then
×
260
       fieldopt_switch = fieldopt_local
×
261
       gf_lo_integrate = .false.
×
262
       if(proc0) then
×
263
          write(*,*) 'gf local fields cannot be used as you are running less MPI processes than there are'
×
264
          write(*,*) 'naky*ntheta0 points.  Defaulting to local fields.  You need to use at least',naky*ntheta0
×
265
          write(*,*) 'MPI processes for this simulation'
×
266
       end if
267
    end if
268

269
    call debug_message(verb, "init_fields: init_antenna")
×
270
    call init_antenna !Must come before allocate_arrays so we know if we need apar_ext
×
271
    call debug_message(verb, "init_fields: allocate_arrays")
×
272
    call allocate_arrays
×
273
  end subroutine fields_pre_init
×
274

275
  !> FIXME : Add documentation  
276
  subroutine init_fields_parameters(fields_config_in)
×
277
    use unit_tests, only: debug_message
278
    implicit none
279
    type(fields_config_type), intent(in), optional :: fields_config_in    
280
    integer, parameter :: verb=3
281
    if (parameters_read) return
×
282
    call debug_message(verb, "init_fields: read_parameters")
×
283
    call read_parameters(fields_config_in)
×
284
    parameters_read = .true.
×
285
  end subroutine init_fields_parameters
286

287
  !> FIXME : Add documentation  
288
  subroutine finish_fields_parameters
×
289
    parameters_read = .false.
×
290
  end subroutine finish_fields_parameters
×
291

292
  !> FIXME : Add documentation  
293
  subroutine init_fields_level_1
×
294
    use unit_tests, only: debug_message
295
    implicit none
296
    integer, parameter :: verb=3
297
    call debug_message(verb, "init_fields: allocate_arrays")
×
298
    call allocate_arrays
×
299
  end subroutine init_fields_level_1
×
300

301
  !> FIXME : Add documentation  
302
  subroutine finish_fields_level_1
×
303
    call finish_fields
×
304
  end subroutine finish_fields_level_1
×
305

306
  !> FIXME : Add documentation  
307
  subroutine init_fields_level_2
×
308
    call init_fields
×
309
  end subroutine init_fields_level_2
×
310

311
  !> FIXME : Add documentation  
312
  subroutine finish_fields_level_2
×
313
    call reset_init
×
314
  end subroutine finish_fields_level_2
×
315

316
  !> FIXME : Add documentation  
317
  subroutine fields_init_response
×
318
    use fields_implicit, only: init_fields_implicit
319
    use fields_test, only: init_fields_test
320
    use fields_local, only: init_fields_local
321
    use fields_gf_local, only: init_fields_gf_local
322
    use unit_tests, only: debug_message
323
    implicit none
324
    integer, parameter :: verb=3
325
    select case (fieldopt_switch)
×
326
    case (fieldopt_implicit)
327
       call debug_message(verb, &
328
         "fields::fields_init_response init_fields_implicit")
×
329
       call init_fields_implicit
×
330
    case (fieldopt_test)
331
       call debug_message(verb, "fields::fields_init_response init_fields_test")
×
332
       call init_fields_test
×
333
    case (fieldopt_local)
334
       call debug_message(verb, &
335
         "fields::fields_init_response init_fields_local")
×
336
       call init_fields_local
×
337
    case (fieldopt_gf_local)
338
       call debug_message(verb, &
339
         "fields::fields_init_response init_fields_gf_local")
×
340
       call init_fields_gf_local
×
341
    case default
342
       !Silently ignore unsupported field options
343
    end select
344
  end subroutine fields_init_response
×
345

346
  !> FIXME : Add documentation  
347
  subroutine init_fields(fields_config_in)
×
348
    use theta_grid, only: init_theta_grid
349
    use run_parameters, only: init_run_parameters
350
    use dist_fn, only: init_dist_fn
351
    use nonlinear_terms, only: nl_finish_init => finish_init
352
    use antenna, only: init_antenna
353
    use kt_grids, only: gridopt_switch, gridopt_box, kwork_filter
354
    implicit none
355
    type(fields_config_type), intent(in), optional :: fields_config_in    
356
    logical, parameter :: debug=.false.
357

358
    if (initialized) return
×
359
    initialized = .true.
×
360
    
361
    call fields_pre_init(fields_config_in)
×
362

363
    call fields_init_response
×
364

365
    ! Turn on nonlinear terms.
366
    if (debug) write(6,*) "init_fields: nl_finish_init"
367
    call nl_finish_init
×
368

369
    !If running in flux tube disable evolution of ky=kx=0 mode
370
    if(gridopt_switch.eq.gridopt_box) kwork_filter(1,1)=.true.
×
371
  end subroutine init_fields
372

373
  !> Force the current response matrices to be written to file
374
  subroutine dump_response_to_file(suffix)
×
375
    use fields_implicit, only: dump_response_to_file_imp
376
    use fields_local, only: dump_response_to_file_local
377
    use fields_gf_local, only: dump_response_to_file_gf_local
378
    implicit none
379
    character(len=*), intent(in), optional :: suffix 
380
    !Note can pass optional straight through as long as also optional
381
    !in called routine (and not different routines combined in interface)
382
    select case (fieldopt_switch)
×
383
    case (fieldopt_implicit)
384
       call dump_response_to_file_imp(suffix)
×
385
    case (fieldopt_local)
386
       call dump_response_to_file_local(suffix)
×
387
    case (fieldopt_gf_local)
388
       call dump_response_to_file_gf_local(suffix)
×
389
    case default
390
       !Silently ignore unsupported field options
391
    end select
392
  end subroutine dump_response_to_file
×
393

394
  !> FIXME : Add documentation
395
  subroutine set_init_fields
×
396
    use fields_implicit, only: init_allfields_implicit
397
    use fields_test, only: init_phi_test
398
    use mp, only: proc0
399
    use fields_local, only: init_allfields_local
400
    use fields_gf_local, only: init_allfields_gf_local
401
    use dist_fn, only: gf_lo_integrate
402
    use gs2_layouts, only: gf_local_fields
403
    use kt_grids, only: naky, ntheta0
404
    implicit none
405
    logical, parameter :: debug=.false.
406
    if(proc0.and.debug) write(6,*) "Syncing fields with g."
407
    select case (fieldopt_switch)
×
408
    case (fieldopt_implicit)
409
       if (debug) write(6,*) "init_fields: init_allfields_implicit"
410
       call init_allfields_implicit
×
411
    case (fieldopt_test)
412
       if (debug) write(6,*) "init_fields: init_phi_test"
413
       call init_phi_test
×
414
    case (fieldopt_local)
415
       if (debug) write(6,*) "init_fields: init_allfields_local"
416
       call init_allfields_local
×
417
    case (fieldopt_gf_local)
418
       if (debug) write(6,*) "init_fields: init_allfields_gf_local"
419
       if(.not. gf_lo_integrate .or. .not. gf_local_fields) then
×
420
          if(proc0) then
×
421
             write(*,*) 'gf_lo_integrate',gf_lo_integrate,'gf_local_fields',gf_local_fields
×
422
             write(*,*) 'gf local fields cannot be used by gf_lo_integrate'
×
423
             write(*,*) 'defaulting to local fields'
×
424
             write(*,*) 'if you want to use gf local fields then set gf_lo_integrate to true in dist_fn_knobs'
×
425
             write(*,*) 'and gf_local_fields to true in layouts_knobs and make sure you are running on more MPI'
×
426
             write(*,*) 'mpi processes than naky*ntheta0.  For this simulation that is: ',naky*ntheta0
×
427
          end if
428
          fieldopt_switch = fieldopt_local
×
429
          call init_allfields_local
×
430
       else
431
          call init_allfields_gf_local
×
432
       end if
433
    end select
434
  end subroutine set_init_fields
×
435

436
  !> FIXME : Add documentation  
437
  subroutine read_parameters(fields_config_in)
×
438
    use file_utils, only: error_unit
439
    use text_options, only: text_option, get_option_value
440
    use fields_implicit, only: field_subgath
441
    use fields_local, only: minNRow
442
    use fields_local, only: do_smart_update, field_local_allreduce, field_local_allreduce_sub
443
    use fields_local, only: field_local_tuneminnrow,  field_local_nonblocking_collectives
444
    use fields_arrays, only: real_response_file => response_file
445
    use file_utils, only: run_name
446
    implicit none
447
    type(fields_config_type), intent(in), optional :: fields_config_in    
448
    character(20) :: field_option
449
    character(len=256) :: response_dir
450
    character(len=256) :: response_file
451
    integer :: ierr, ind_slash
452

453
    if (present(fields_config_in)) fields_config = fields_config_in
×
454

455
    call fields_config%init(name = 'fields_knobs', requires_index = .false.)
×
456

457
    ! Copy out internal values into module level parameters
458
    associate(self => fields_config)
459
#include "fields_copy_out_auto_gen.inc"
460
    end associate
461

462
    ierr = error_unit()
×
463
    call get_option_value &
464
         (field_option, fieldopts, fieldopt_switch, &
465
         ierr, "field_option in fields_knobs",.true.)
×
466

467
    if (trim(response_file) == '') then
×
468
       response_file = trim(run_name)
×
469
    end if
470

471
    if(trim(response_dir).eq.'')then
×
472
       write(real_response_file,'(A)') trim(response_file)
×
473
    else
474
       ! Need to check if resopnse_file has a directory path in it
475
       ! to ensure we merge with response_dir correctly. For example,
476
       ! consider response_file = '../../run/input' and response_dir = 'resp'.
477
       ! We want to form response_file = '../../run/resp/input' and not
478
       ! 'resp/../../run/input' as would happen if just concatenate.
479
       ! Check for index of last '/'
480
       ind_slash = index(response_file, "/", back = .true.)
×
481
       if (ind_slash == 0) then
×
482
          write(real_response_file,'(A,"/",A)') trim(response_dir),trim(response_file)
×
483
       else
484
          write(real_response_file,'(A,A,"/",A)') &
485
               response_file(1:ind_slash), &
×
486
               trim(response_dir), &
×
487
               trim(response_file(ind_slash+1:))
×
488
       end if
489
    endif
490

491
    !Set the solve type specific flags
492
    call set_dump_and_read_response(dump_response, read_response)
×
493
  end subroutine read_parameters
×
494

495
  !> FIXME : Add documentation  
496
  subroutine set_dump_and_read_response(dump_flag, read_flag)
×
497
    use fields_implicit, only: dump_response_imp => dump_response, read_response_imp=>read_response
498
    use fields_local, only: dump_response_loc => dump_response, read_response_loc=>read_response
499
    use fields_gf_local, only: dump_response_gf => dump_response, read_response_gf=>read_response
500
    implicit none
501
    logical, intent(in) :: dump_flag, read_flag
502
    select case (fieldopt_switch)
×
503
    case (fieldopt_implicit)
504
       dump_response_imp=dump_flag
×
505
       read_response_imp=read_flag
×
506
    case (fieldopt_local)
507
       dump_response_loc=dump_flag
×
508
       read_response_loc=read_flag
×
509
    case (fieldopt_gf_local)
510
       dump_response_gf=dump_flag
×
511
       read_response_gf=read_flag
×
512
    case default
513
       !Silently ignore unsupported field types
514
    end select
515
  end subroutine set_dump_and_read_response
×
516

517
  !> FIXME : Add documentation  
518
  subroutine allocate_arrays
×
519
    use theta_grid, only: ntgrid
520
    use kt_grids, only: naky, ntheta0
521
    use antenna, only: no_driver
522
    use fields_arrays, only: phi, apar, bpar, phinew, aparnew, bparnew, apar_ext
523
    use fields_arrays, only: gf_phi, gf_apar, gf_bpar, gf_phinew, gf_aparnew, gf_bparnew
524
    use unit_tests, only: debug_message
525
    use array_utils, only: zero_array
526
    implicit none
527
    integer, parameter :: verb=3
528

529
    if (.not. allocated(phi)) then
×
530
       call debug_message(verb, 'fields::allocate_arrays allocating')
×
531
       allocate (     phi (-ntgrid:ntgrid,ntheta0,naky))
×
532
       allocate (    apar (-ntgrid:ntgrid,ntheta0,naky))
×
533
       allocate (   bpar (-ntgrid:ntgrid,ntheta0,naky))
×
534
       allocate (  phinew (-ntgrid:ntgrid,ntheta0,naky))
×
535
       allocate ( aparnew (-ntgrid:ntgrid,ntheta0,naky))
×
536
       allocate (bparnew (-ntgrid:ntgrid,ntheta0,naky))
×
537
       if(fieldopt_switch .eq. fieldopt_gf_local) then
×
538
          !AJ It should be possible to reduce the size of these by only allocating them
539
          !AJ the extend of it and ik in gf_lo.  However, it would need to be done carefully 
540
          !AJ to ensure the proc0 has the full space if we are still reducing data to proc0 
541
          !AJ for diagnostics.
542
          !AJ With some careful thought it should also be possible to remove this all together and 
543
          !AJ simply use the arrays above, but that would need checking
544
          allocate (    gf_phi (-ntgrid:ntgrid,ntheta0,naky))
×
545
          allocate (   gf_apar (-ntgrid:ntgrid,ntheta0,naky))
×
546
          allocate (   gf_bpar (-ntgrid:ntgrid,ntheta0,naky))          
×
547
          allocate ( gf_phinew (-ntgrid:ntgrid,ntheta0,naky))
×
548
          allocate (gf_aparnew (-ntgrid:ntgrid,ntheta0,naky))
×
549
          allocate (gf_bparnew (-ntgrid:ntgrid,ntheta0,naky))          
×
550
       end if
551
    endif
552
    !AJ This shouldn't be necessary as it is done in the fields code....
553
    call zero_array(phi) ; call zero_array(phinew)
×
554
    call zero_array(apar) ; call zero_array(aparnew)
×
555
    call zero_array(bpar) ; call zero_array(bparnew)
×
556
    if(fieldopt_switch .eq. fieldopt_gf_local) then
×
557
       call zero_array(gf_phi) ; call zero_array(gf_phinew)
×
558
       call zero_array(gf_apar) ; call zero_array(gf_aparnew)
×
559
       call zero_array(gf_bpar) ; call zero_array(gf_bparnew)
×
560
    end if
561
    if(.not.allocated(apar_ext).and.(.not.no_driver))then
×
562
       allocate (apar_ext (-ntgrid:ntgrid,ntheta0,naky))
×
563
       call zero_array(apar_ext)
×
564
    endif
565
  end subroutine allocate_arrays
×
566

567
  !> FIXME : Add documentation  
568
  subroutine advance (istep)
×
569
    use fields_implicit, only: advance_implicit
570
    use fields_test, only: advance_test
571
    use fields_local, only: advance_local
572
    use fields_gf_local, only: advance_gf_local
573

574
    implicit none
575
    integer, intent (in) :: istep
576

577
    select case (fieldopt_switch)
×
578
    case (fieldopt_implicit)
579
       call advance_implicit (istep, remove_zonal_flows_switch)
×
580
    case (fieldopt_test)
581
       call advance_test (istep)
×
582
    case (fieldopt_local)
583
       call advance_local (istep, remove_zonal_flows_switch)
×
584
    case (fieldopt_gf_local)
585
       call advance_gf_local (istep, remove_zonal_flows_switch)
×
586
    end select
587
  end subroutine advance
×
588

589
  !> FIXME : Add documentation  
590
  subroutine reset_init
×
591
    use fields_implicit, only: fi_reset => reset_init
592
    use fields_test, only: ft_reset => reset_init
593
    use fields_local, only: fl_reset => reset_fields_local
594
    use fields_gf_local, only: flgf_reset => reset_fields_gf_local
595
    use fields_arrays, only: phi, apar, bpar, phinew, aparnew, bparnew
596
    use fields_arrays, only: gf_phi, gf_apar, gf_bpar, gf_phinew, gf_aparnew, gf_bparnew
597
    use array_utils, only: zero_array
598
    implicit none
599
    initialized  = .false.
×
600
    call zero_array(phi) ; call zero_array(phinew)
×
601
    call zero_array(apar) ; call zero_array(aparnew)
×
602
    call zero_array(bpar) ; call zero_array(bparnew)
×
603
    if(fieldopt_switch .eq. fieldopt_gf_local) then
×
604
       call zero_array(gf_phi) ; call zero_array(gf_phinew)
×
605
       call zero_array(gf_apar) ; call zero_array(gf_aparnew)
×
606
       call zero_array(gf_bpar) ; call zero_array(gf_bparnew)
×
607
    end if
608
    !What about apar_ext?
609
    select case (fieldopt_switch)
×
610
    case (fieldopt_implicit)
611
       call fi_reset
×
612
    case (fieldopt_test)
613
       call ft_reset
×
614
    case (fieldopt_local)
615
       call fl_reset
×
616
    case (fieldopt_gf_local)
617
       call flgf_reset
×
618
    end select
619
  end subroutine reset_init
×
620

621
  !> FIXME : Add documentation  
622
  subroutine finish_fields
×
623
    use fields_implicit, only: implicit_reset => reset_init
624
    use fields_test, only: test_reset => reset_init
625
    use fields_local, only: finish_fields_local
626
    use fields_gf_local, only: finish_fields_gf_local
627
    use fields_arrays, only: phi, apar, bpar, phinew, aparnew, bparnew
628
    use fields_arrays, only: apar_ext, gf_phi, gf_apar, gf_bpar
629
    use fields_arrays, only: apar_ext, gf_phinew, gf_aparnew, gf_bparnew
630
    use unit_tests, only: debug_message
631
    use array_utils, only: zero_array
632
    implicit none
633
    integer, parameter :: verbosity = 3
634

635
    initialized  = .false.
×
636
!AJ Does these need zero'd if they are to be deallocated below?
637
    call zero_array(phi) ; call zero_array(phinew)
×
638
    call zero_array(apar) ; call zero_array(aparnew)
×
639
    call zero_array(bpar) ; call zero_array(bparnew)
×
640
    call debug_message(verbosity, &
641
      'fields::finish_fields zeroed fields')
×
642
    
643
    select case (fieldopt_switch)
×
644
    case (fieldopt_implicit)
645
       ! This line is no longer necessary
646
       ! because fields_implicit::reset_init is
647
       ! called by finish_fields_level_2
648
       !call implicit_reset
649
    case (fieldopt_test)
650
       ! This line is no longer necessary
651
       ! because fields_test::reset_init is
652
       ! called by finish_fields_level_2
653
       !call test_reset
654
    case (fieldopt_local)
655
       call finish_fields_local
×
656
    case (fieldopt_gf_local)
657
       call finish_fields_gf_local
×
658
    end select
659

660
    call debug_message(verbosity, &
661
      'fields::finish_fields called subroutines')
×
662

663
    if (allocated(phi)) deallocate (phi, apar, bpar, phinew, aparnew, bparnew)
×
664
    if (allocated(gf_phi)) deallocate(gf_phi, gf_apar, gf_bpar, gf_phinew, gf_aparnew, gf_bparnew)
×
665
    if (allocated(apar_ext)) deallocate (apar_ext)
×
666
    call debug_message(verbosity, &
667
      'fields::finish_fields deallocated fields')
×
668

669
    call fields_config%reset()
×
670
  end subroutine finish_fields
×
671

672
#include "fields_auto_gen.inc"  
673
end module fields
×
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