1663582644

Committed 10 Feb 2025 10:47AM UTC coverage: 7.92% (+0.003%) from 7.917%

Build Type

push

gitlab-ci

Committed by David Dickinson

Commit Message

Merged in bugfix/make_sure_multigs2_actually_times_jobs (pull request #1094)

Run Details

3690 of 46590 relevant lines covered (7.92%)

99873.61 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
  integer :: original_comm_world
  logical :: no_work_for_this_proc, local_proc0, actual_proc0
  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)

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

  ! 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, '')
     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"
    logical :: skip

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

gyrokinetics / gs2 / 1663582644

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