1969605222

Committed 06 Aug 2025 09:58AM UTC coverage: 8.231% (+0.01%) from 8.219%

Build # 1969605222

Build Type

push

gitlab-ci

Committed by David Dickinson

Commit Message

Merged in minor/refactor_initialising_of_nonlinear_terms_to_simplify_setup (pull request #1106)

Run Details

3710 of 45073 relevant lines covered (8.23%)

123835.53 hits per line

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

0.0

/src/programs/multigs2.fpp

!> A small program designed to enable the use of mutiple
!> input files at once and / or a queue of input files
!> in a single process. Limited features right now (e.g.
!> no load balancing etc.) but can still be useful.
program multigs2
  use mp, only: init_mp, mp_comm, finish_mp, proc0, nproc, time_message, barrier
  use mp, only: broadcast, iproc, mp_undefined, split, rank_comm, free_comm
  use gs2_main, only : run_gs2, gs2_program_state_type
  use constants, only: run_name_size
  use standard_header, only: date_iso8601
  implicit none
  ! Command line options
  integer :: nbatch !< Number of simultaneous runs to progress
  character(len=:), allocatable :: set_file !< File containing list of jobs to run
  logical :: debug
  ! End of command line options
  type(gs2_program_state_type) :: state
  integer :: sub_comm, nfiles, nproc_per_batch, local_iproc, num_my_jobs, batch_id, i, j
  integer :: original_comm_world, nfiles_per_batch
  logical :: no_work_for_this_proc, local_proc0, actual_proc0
  logical :: sequential_order, report_batches, dry_run
  integer, dimension(:), allocatable :: subset_in_charge
  character(len = run_name_size), dimension(:), allocatable :: files, my_files
  real, dimension(2) :: main_timer, job_timer
  main_timer = 0. ; job_timer = 0.
  call parse_command_line()
  call init_mp
  actual_proc0 = proc0
  original_comm_world = mp_comm
  if (proc0) write(*, '("Run started at ",A)') date_iso8601()

  call time_message(.false., main_timer, '')

  if (proc0) call parse_set_file_to_files(set_file, nfiles, files)

  ! Ensure all processors know how many files there are
  call broadcast(nfiles)

  ! Limit nbatch to be no larger than the number of processors
  if (debug .and. nbatch > nproc .and. proc0) then
     write(*,'("Warning: nbatch (",I0,") > nproc (",I0,") -- reducing nbatch")') nbatch, nproc
  end if
  nbatch = min(nbatch, nproc)
  nbatch = min(nbatch, nfiles)

  ! Distribute file list to all processors
  if (.not. proc0) allocate(files(nfiles))
  call broadcast(files)

  ! Note that if nfiles doesn't have nbatch as a factor nfiles_per_batch is not
  ! exactly accurate so we round up here to ensure nfiles_per_batch * nbatch >= nfiles
  nfiles_per_batch = ceiling(nfiles * 1.0 / nbatch)

  ! Determine which processor sub-set will be responsible for each file
  allocate(subset_in_charge(nfiles))
  do i = 1, nfiles
     if (sequential_order) then
        ! Sequential chunks
        subset_in_charge(i) = 1 + ((i - 1) / nfiles_per_batch)
     else
        ! Striped / strided ownership
        subset_in_charge(i) = 1 + mod(i, nbatch)
     end if
  end do

  if (report_batches) then
     if (proc0) then
        do i = 1, nbatch
           my_files = pack(files, subset_in_charge == i)
           write(6,'("Batch ",I0," (",I0," files) :")') i, size(my_files)
           do j = 1, size(my_files)
              write(6, '("    ",A)') trim(adjustl(my_files(j)))
           end do
           write(6,'()')
        end do
     end if
  end if

  ! Work out how many processors there are for each subset
  nproc_per_batch = nproc / nbatch

  if (proc0) then
     write(*,'("Processing ",I0," files in ",I0," batches with ",I0," processors/batch")') &
          nfiles, nbatch, nproc_per_batch
  end if

  ! Work out which subset this processor belongs to
  batch_id = 1 + iproc / nproc_per_batch

  ! Determine the list of files this processor is involved in and count them
  my_files = pack(files, subset_in_charge == batch_id)
  num_my_jobs = size(my_files)

  ! Check if we're in a batch without any work (processors don't split
  ! perfectly into the requested number of batches)
  if (num_my_jobs < 1) then
     ! Change batch_id to mp_undefined here so that in the split call
     ! they just get a null communicator
     batch_id = mp_undefined
     no_work_for_this_proc = .true.
  else
     no_work_for_this_proc = .false.
  end if

  ! Split comm world into sub-communicators for each processor subset
  call split(batch_id, sub_comm)

  ! Copy information into the state object
  state%mp_comm = sub_comm
  state%run_name_external = .true.
  state%is_external_job = .true.
  state%print_full_timers = .false.
  state%print_times = .false.

  if (no_work_for_this_proc) then
     local_proc0 = .false.
  else
     call rank_comm(sub_comm, local_iproc)
     local_proc0 = local_iproc == 0
  end if

  if (debug .and. proc0 .and. (nproc_per_batch * nbatch /= nproc)) then
     write(*,'("Note : ",I0," processors unused.")') nproc - nproc_per_batch * nbatch
  end if

  do i = 1, num_my_jobs
     state%run_name = my_files(i)
     job_timer = 0.0
     if (debug .and. local_proc0) &
          write(*, '("Batch : ",I0," Starting job ",I0," of ",I0," : ",A)') &
          batch_id, i, num_my_jobs, trim(state%run_name)
     call time_message(.false., job_timer, '')
     if (.not. dry_run) call run_gs2(state, quiet = .true.)
     call time_message(.false., job_timer, '')
     if (debug .and. local_proc0) &
          write(*, '("Batch : ",I0," Done job ",I0," of ",I0," : ",A," in ",0pF9.3," s")') &
          batch_id, i, num_my_jobs, trim(state%run_name), job_timer(1)
  end do
  call time_message(.false., main_timer, '')
  if (.not. no_work_for_this_proc) call free_comm(sub_comm)
  if (debug .and. local_proc0) &
       write(*, '("Batch : ",I0," finished in ",0pF9.3," s")') batch_id, main_timer(1)
  call barrier(original_comm_world)
  call finish_mp
  if (actual_proc0) write(*, '("Run finished at ",A)') date_iso8601()
contains
  !> Parse the command line to determine user options
  subroutine parse_command_line()
    use git_version_mod, only: get_git_version
    integer :: arg_count, arg_n
    character(len=:), allocatable :: argument
    character(len=*), parameter :: nl = new_line('a')
    character(len=*), parameter :: usage = &
         "multigs2 [--version|-v] [--help|-h] [--nbatch <n>] [--debug] [input file]" // nl // nl // &
         "Wrapper for GS2 to run multiple jobs in a single execution" // nl // &
         "For more help, see the documentation at https://gyrokinetics.gitlab.io/gs2/" // nl // &
         "or create an issue https://bitbucket.org/gyrokinetics/gs2/issues?status=open" // nl // &
         nl // &
         "  -h, --help           Print this message" // nl // &
         "  -v, --version        Print the GS2 version" // nl // &
         "  --nbatch <n>         Sets the number of simultaneous jobs to use" // nl // &
         "  --debug              Enables more verbose screen output" // nl // &
         "  --sequential         Split jobs over batches in sequential chunks " // nl // &
         "                       rather than round robin" // nl // &
         "  --report-batches     Report the distribution of jobs into batches and then stop" // nl // &
         "  --dry-run            If set then do everything except run gs2"
    logical :: skip

    ! Set default options
    nbatch = 1 ; debug = .false. ; sequential_order = .false. ; report_batches = .false.
    dry_run = .false.

    arg_count = command_argument_count()
    skip = .false.
    do arg_n = 1, arg_count
       if (skip) then
          skip = .false.
          cycle
       end if

       call get_arg(arg_n, argument)

       if ((argument == "--help") .or. (argument == "-h")) then
          write(*, '(a)') usage
          stop
       else if ((argument == "--version") .or. (argument == "-v")) then
          write(*, '("GS2 version ", a)') get_git_version()
          stop
       else if ((argument == "--nbatch") .or. (argument == "-n")) then
          if (arg_n == arg_count) error stop "Missing nbatch value"
          call get_arg(arg_n + 1, argument)
          read(argument, *) nbatch
          skip = .true.
       else if ((argument == "--debug") .or. (argument == "-d")) then
          debug = .true.
       else if ((argument == "--sequential")) then
          sequential_order = .true.
       else if ((argument == "--report-batches")) then
          report_batches = .true.
       else if ((argument == "--dry-run")) then
          dry_run = .true.
       else
          call get_arg(arg_n, set_file)
       end if
    end do

    if (.not. allocated(set_file)) then
       error stop 'No set_file found when parsing command line'
    end if
  end subroutine parse_command_line

  subroutine get_arg(arg_n, arg)
    integer, intent(in) :: arg_n
    character(len=:), allocatable, intent(in out) :: arg
    integer :: arg_length
    call get_command_argument(arg_n, length=arg_length)
    if (allocated(arg)) deallocate(arg)
    allocate(character(len=arg_length)::arg)
    call get_command_argument(arg_n, arg)
  end subroutine get_arg

  subroutine parse_set_file_to_files(set_file, nfiles, files)
    implicit none
    character(len = *), intent(in) :: set_file
    integer, intent(out) :: nfiles
    character(len = run_name_size), allocatable, dimension(:), intent(out) :: files
    character(len = run_name_size) :: line
    integer :: file_unit, ierr, i
    open(newunit = file_unit, file = set_file, action = 'read')
    ! First count how many jobs we have, based on how many lines in file
    nfiles = 0 ; ierr = 0
    do while (ierr == 0)
       read(unit = file_unit, fmt = *, iostat = ierr) line
       line = strip_comment_and_space(line)
       if (len_trim(line) > 0 .and. ierr == 0) nfiles = nfiles + 1
    end do

    ! Reset to start of file
    rewind(unit = file_unit)

    ! Read in each line as store in files array
    allocate(files(nfiles)) ; i = 0
    do while (i < nfiles)
       read(unit = file_unit, fmt = '(a)') line
       line = strip_comment_and_space(line)
       if (len_trim(line) > 0) then
          i = i + 1
          files(i) = trim(line)
       end if
    end do
    close(file_unit)
  end subroutine parse_set_file_to_files

  pure function strip_comment_and_space(line) result(clean_line)
    character(len=*), intent(in) :: line
    character(len=:), allocatable :: clean_line
    integer :: first_comment
    first_comment = scan(line, '!')
    if (first_comment == 0) then
       clean_line = line
    else
       clean_line = line(1 : first_comment - 1)
    end if
    clean_line = trim(adjustl(clean_line))
  end function strip_comment_and_space

end program multigs2

1	!> A small program designed to enable the use of mutiple
2	!> input files at once and / or a queue of input files
3	!> in a single process. Limited features right now (e.g.
4	!> no load balancing etc.) but can still be useful.
5	program multigs2	×
6	use mp, only: init_mp, mp_comm, finish_mp, proc0, nproc, time_message, barrier	×
7	use mp, only: broadcast, iproc, mp_undefined, split, rank_comm, free_comm
8	use gs2_main, only : run_gs2, gs2_program_state_type
9	use constants, only: run_name_size
10	use standard_header, only: date_iso8601
11	implicit none
12	! Command line options
13	integer :: nbatch !< Number of simultaneous runs to progress
14	character(len=:), allocatable :: set_file !< File containing list of jobs to run	×
15	logical :: debug
16	! End of command line options
17	type(gs2_program_state_type) :: state	×
18	integer :: sub_comm, nfiles, nproc_per_batch, local_iproc, num_my_jobs, batch_id, i, j
19	integer :: original_comm_world, nfiles_per_batch
20	logical :: no_work_for_this_proc, local_proc0, actual_proc0
21	logical :: sequential_order, report_batches, dry_run
22	integer, dimension(:), allocatable :: subset_in_charge	×
23	character(len = run_name_size), dimension(:), allocatable :: files, my_files	×
24	real, dimension(2) :: main_timer, job_timer
25	main_timer = 0. ; job_timer = 0.	×
26	call parse_command_line()	×
27	call init_mp	×
28	actual_proc0 = proc0	×
29	original_comm_world = mp_comm	×
30	if (proc0) write(*, '("Run started at ",A)') date_iso8601()	×
31
32	call time_message(.false., main_timer, '')	×
33
34	if (proc0) call parse_set_file_to_files(set_file, nfiles, files)	×
35
36	! Ensure all processors know how many files there are
37	call broadcast(nfiles)	×
38
39	! Limit nbatch to be no larger than the number of processors
40	if (debug .and. nbatch > nproc .and. proc0) then	×
41	write(*,'("Warning: nbatch (",I0,") > nproc (",I0,") -- reducing nbatch")') nbatch, nproc	×
42	end if
43	nbatch = min(nbatch, nproc)	×
44	nbatch = min(nbatch, nfiles)	×
45
46	! Distribute file list to all processors
47	if (.not. proc0) allocate(files(nfiles))	×
48	call broadcast(files)	×
49
50	! Note that if nfiles doesn't have nbatch as a factor nfiles_per_batch is not
51	! exactly accurate so we round up here to ensure nfiles_per_batch * nbatch >= nfiles
52	nfiles_per_batch = ceiling(nfiles * 1.0 / nbatch)	×
53
54	! Determine which processor sub-set will be responsible for each file
55	allocate(subset_in_charge(nfiles))	×
56	do i = 1, nfiles	×
57	if (sequential_order) then	×
58	! Sequential chunks
59	subset_in_charge(i) = 1 + ((i - 1) / nfiles_per_batch)	×
60	else
61	! Striped / strided ownership
62	subset_in_charge(i) = 1 + mod(i, nbatch)	×
63	end if
64	end do
65
66	if (report_batches) then	×
67	if (proc0) then	×
68	do i = 1, nbatch	×
69	my_files = pack(files, subset_in_charge == i)	×
70	write(6,'("Batch ",I0," (",I0," files) :")') i, size(my_files)	×
71	do j = 1, size(my_files)	×
72	write(6, '(" ",A)') trim(adjustl(my_files(j)))	×
73	end do
74	write(6,'()')	×
75	end do
76	end if
77	end if
78
79	! Work out how many processors there are for each subset
80	nproc_per_batch = nproc / nbatch	×
81
82	if (proc0) then	×
83	write(*,'("Processing ",I0," files in ",I0," batches with ",I0," processors/batch")') &
84	nfiles, nbatch, nproc_per_batch	×
85	end if
86
87	! Work out which subset this processor belongs to
88	batch_id = 1 + iproc / nproc_per_batch	×
89
90	! Determine the list of files this processor is involved in and count them
91	my_files = pack(files, subset_in_charge == batch_id)	×
92	num_my_jobs = size(my_files)	×
93
94	! Check if we're in a batch without any work (processors don't split
95	! perfectly into the requested number of batches)
96	if (num_my_jobs < 1) then	×
97	! Change batch_id to mp_undefined here so that in the split call
98	! they just get a null communicator
99	batch_id = mp_undefined	×
100	no_work_for_this_proc = .true.	×
101	else
102	no_work_for_this_proc = .false.	×
103	end if
104
105	! Split comm world into sub-communicators for each processor subset
106	call split(batch_id, sub_comm)	×
107
108	! Copy information into the state object
109	state%mp_comm = sub_comm	×
110	state%run_name_external = .true.	×
111	state%is_external_job = .true.	×
112	state%print_full_timers = .false.	×
113	state%print_times = .false.	×
114
115	if (no_work_for_this_proc) then	×
116	local_proc0 = .false.	×
117	else
118	call rank_comm(sub_comm, local_iproc)	×
119	local_proc0 = local_iproc == 0	×
120	end if
121
122	if (debug .and. proc0 .and. (nproc_per_batch * nbatch /= nproc)) then	×
123	write(,'("Note : ",I0," processors unused.")') nproc - nproc_per_batch nbatch	×
124	end if
125
126	do i = 1, num_my_jobs	×
127	state%run_name = my_files(i)	×
128	job_timer = 0.0	×
129	if (debug .and. local_proc0) &	×
130	write(*, '("Batch : ",I0," Starting job ",I0," of ",I0," : ",A)') &
131	batch_id, i, num_my_jobs, trim(state%run_name)	×
132	call time_message(.false., job_timer, '')	×
133	if (.not. dry_run) call run_gs2(state, quiet = .true.)	×
134	call time_message(.false., job_timer, '')	×
135	if (debug .and. local_proc0) &	×
136	write(*, '("Batch : ",I0," Done job ",I0," of ",I0," : ",A," in ",0pF9.3," s")') &
137	batch_id, i, num_my_jobs, trim(state%run_name), job_timer(1)	×
138	end do
139	call time_message(.false., main_timer, '')	×
140	if (.not. no_work_for_this_proc) call free_comm(sub_comm)	×
141	if (debug .and. local_proc0) &	×
142	write(*, '("Batch : ",I0," finished in ",0pF9.3," s")') batch_id, main_timer(1)	×
143	call barrier(original_comm_world)	×
144	call finish_mp	×
145	if (actual_proc0) write(*, '("Run finished at ",A)') date_iso8601()	×
146	contains
147	!> Parse the command line to determine user options
148	subroutine parse_command_line()	×
149	use git_version_mod, only: get_git_version
150	integer :: arg_count, arg_n
151	character(len=:), allocatable :: argument	×
152	character(len=*), parameter :: nl = new_line('a')
153	character(len=*), parameter :: usage = &
154	"multigs2 [--version\|-v] [--help\|-h] [--nbatch <n>] [--debug] [input file]" // nl // nl // &
155	"Wrapper for GS2 to run multiple jobs in a single execution" // nl // &
156	"For more help, see the documentation at https://gyrokinetics.gitlab.io/gs2/" // nl // &
157	"or create an issue https://bitbucket.org/gyrokinetics/gs2/issues?status=open" // nl // &
158	nl // &
159	" -h, --help Print this message" // nl // &
160	" -v, --version Print the GS2 version" // nl // &
161	" --nbatch <n> Sets the number of simultaneous jobs to use" // nl // &
162	" --debug Enables more verbose screen output" // nl // &
163	" --sequential Split jobs over batches in sequential chunks " // nl // &
164	" rather than round robin" // nl // &
165	" --report-batches Report the distribution of jobs into batches and then stop" // nl // &
166	" --dry-run If set then do everything except run gs2"
167	logical :: skip
168
169	! Set default options
170	nbatch = 1 ; debug = .false. ; sequential_order = .false. ; report_batches = .false.	×
171	dry_run = .false.	×
172
173	arg_count = command_argument_count()	×
174	skip = .false.	×
175	do arg_n = 1, arg_count	×
176	if (skip) then	×
177	skip = .false.	×
178	cycle	×
179	end if
180
181	call get_arg(arg_n, argument)	×
182
183	if ((argument == "--help") .or. (argument == "-h")) then	×
184	write(*, '(a)') usage	×
185	stop	×
186	else if ((argument == "--version") .or. (argument == "-v")) then	×
187	write(*, '("GS2 version ", a)') get_git_version()	×
188	stop	×
189	else if ((argument == "--nbatch") .or. (argument == "-n")) then	×
190	if (arg_n == arg_count) error stop "Missing nbatch value"	×
191	call get_arg(arg_n + 1, argument)	×
192	read(argument, *) nbatch	×
193	skip = .true.	×
194	else if ((argument == "--debug") .or. (argument == "-d")) then	×
195	debug = .true.	×
196	else if ((argument == "--sequential")) then	×
197	sequential_order = .true.	×
198	else if ((argument == "--report-batches")) then	×
199	report_batches = .true.	×
200	else if ((argument == "--dry-run")) then	×
201	dry_run = .true.	×
202	else
203	call get_arg(arg_n, set_file)	×
204	end if
205	end do
206
207	if (.not. allocated(set_file)) then	×
208	error stop 'No set_file found when parsing command line'	×
209	end if
210	end subroutine parse_command_line	×
211
212	subroutine get_arg(arg_n, arg)	×
213	integer, intent(in) :: arg_n
214	character(len=:), allocatable, intent(in out) :: arg
215	integer :: arg_length
216	call get_command_argument(arg_n, length=arg_length)	×
217	if (allocated(arg)) deallocate(arg)	×
218	allocate(character(len=arg_length)::arg)	×
219	call get_command_argument(arg_n, arg)	×
220	end subroutine get_arg	×
221
222	subroutine parse_set_file_to_files(set_file, nfiles, files)	×
223	implicit none
224	character(len = *), intent(in) :: set_file
225	integer, intent(out) :: nfiles
226	character(len = run_name_size), allocatable, dimension(:), intent(out) :: files
227	character(len = run_name_size) :: line
228	integer :: file_unit, ierr, i
229	open(newunit = file_unit, file = set_file, action = 'read')	×
230	! First count how many jobs we have, based on how many lines in file
231	nfiles = 0 ; ierr = 0	×
232	do while (ierr == 0)	×
233	read(unit = file_unit, fmt = *, iostat = ierr) line	×
234	line = strip_comment_and_space(line)	×
235	if (len_trim(line) > 0 .and. ierr == 0) nfiles = nfiles + 1	×
236	end do
237
238	! Reset to start of file
239	rewind(unit = file_unit)	×
240
241	! Read in each line as store in files array
242	allocate(files(nfiles)) ; i = 0	×
243	do while (i < nfiles)	×
244	read(unit = file_unit, fmt = '(a)') line	×
245	line = strip_comment_and_space(line)	×
246	if (len_trim(line) > 0) then	×
247	i = i + 1	×
248	files(i) = trim(line)	×
249	end if
250	end do
251	close(file_unit)	×
252	end subroutine parse_set_file_to_files	×
253
254	pure function strip_comment_and_space(line) result(clean_line)	×
255	character(len=*), intent(in) :: line
256	character(len=:), allocatable :: clean_line
257	integer :: first_comment
258	first_comment = scan(line, '!')	×
259	if (first_comment == 0) then	×
260	clean_line = line	×
261	else
262	clean_line = line(1 : first_comment - 1)	×
263	end if
264	clean_line = trim(adjustl(clean_line))	×
265	end function strip_comment_and_space	×
266
267	end program multigs2

gyrokinetics / gs2 / 1969605222

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

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