17 cp_iteration_info_type
38 #include "../base/base_uses.f90"
43 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'swarm_mpi'
50 TYPE(mp_para_env_type),
POINTER :: world => null()
51 TYPE(mp_para_env_type),
POINTER :: worker => null()
52 TYPE(mp_para_env_type),
POINTER :: master => null()
53 INTEGER,
DIMENSION(:),
ALLOCATABLE :: wid2group
54 CHARACTER(LEN=default_path_length) :: master_output_path =
""
55 END TYPE swarm_mpi_type
69 SUBROUTINE swarm_mpi_init(swarm_mpi, world_para_env, root_section, n_workers, worker_id, iw)
71 TYPE(mp_para_env_type),
POINTER :: world_para_env
72 TYPE(section_vals_type),
POINTER :: root_section
73 INTEGER,
INTENT(IN) :: n_workers
74 INTEGER,
INTENT(OUT) :: worker_id
75 INTEGER,
INTENT(IN) :: iw
77 INTEGER :: n_groups_created, pe_per_worker, &
78 subgroup_rank, subgroup_size
79 TYPE(mp_comm_type) :: subgroup
80 LOGICAL :: im_the_master
81 INTEGER,
DIMENSION(:),
POINTER :: group_distribution_p
82 INTEGER,
DIMENSION(0:world_para_env%num_pe-2), &
83 TARGET :: group_distribution
90 IF (mod(
swarm_mpi%world%num_pe - 1, n_workers) /= 0)
THEN
91 cpabort(
"number of processors-1 is not divisible by n_workers.")
93 IF (
swarm_mpi%world%num_pe < n_workers + 1)
THEN
94 cpabort(
"There are not enough processes for n_workers + 1. Aborting.")
97 pe_per_worker = (
swarm_mpi%world%num_pe - 1)/n_workers
100 WRITE (iw,
'(A,45X,I8)')
" SWARM| Number of mpi ranks",
swarm_mpi%world%num_pe
101 WRITE (iw,
'(A,47X,I8)')
" SWARM| Number of workers", n_workers
108 IF (im_the_master)
THEN
113 IF (
swarm_mpi%master%num_pe /= 1) cpabort(
"mp_comm_split_direct failed (master)")
115 CALL subgroup%from_split(
swarm_mpi%world, 2)
116 subgroup_size = subgroup%num_pe
117 subgroup_rank = subgroup%mepos
118 IF (subgroup_size /=
swarm_mpi%world%num_pe - 1) cpabort(
"mp_comm_split_direct failed (worker)")
121 ALLOCATE (
swarm_mpi%wid2group(n_workers))
124 IF (.NOT. im_the_master)
THEN
126 group_distribution_p => group_distribution
128 CALL swarm_mpi%worker%from_split(subgroup, n_groups_created, group_distribution_p, n_subgroups=n_workers)
129 worker_id = group_distribution(subgroup_rank) + 1
130 IF (n_groups_created /= n_workers) cpabort(
"mp_comm_split failed.")
145 CALL logger_init_worker(
swarm_mpi, root_section, worker_id)
153 SUBROUTINE logger_init_master(swarm_mpi)
156 INTEGER :: output_unit
157 TYPE(cp_logger_type),
POINTER :: logger
163 output_unit = logger%default_local_unit_nr
164 swarm_mpi%master_output_path = output_unit2path(output_unit)
173 END SUBROUTINE logger_init_master
181 FUNCTION output_unit2path(output_unit)
RESULT(output_path)
182 INTEGER,
INTENT(IN) :: output_unit
183 CHARACTER(LEN=default_path_length) :: output_path
185 output_path =
"__STD_OUT__"
187 INQUIRE (unit=output_unit, name=output_path)
188 END FUNCTION output_unit2path
197 SUBROUTINE logger_init_worker(swarm_mpi, root_section, worker_id)
199 TYPE(section_vals_type),
POINTER :: root_section
202 CHARACTER(LEN=default_path_length) :: output_path
203 CHARACTER(len=default_string_length) :: new_project_name, project_name, &
205 TYPE(cp_iteration_info_type),
POINTER :: new_iter_info
206 TYPE(cp_logger_type),
POINTER :: old_logger
208 NULLIFY (old_logger, new_iter_info)
211 project_name = old_logger%iter_info%project_name
212 IF (worker_id > 99999)
THEN
213 cpabort(
"Did not expect so many workers.")
215 WRITE (worker_name,
"(A,I5.5)")
'WORKER', worker_id
217 cpabort(
"project name too long")
219 output_path = trim(project_name)//
"-"//trim(worker_name)//
".out"
220 new_project_name = trim(project_name)//
"-"//trim(worker_name)
223 CALL error_add_new_logger(
swarm_mpi%worker, output_path, new_iter_info)
226 END SUBROUTINE logger_init_worker
235 SUBROUTINE error_add_new_logger(para_env, output_path, iter_info)
236 TYPE(mp_para_env_type),
POINTER :: para_env
237 CHARACTER(LEN=default_path_length) :: output_path
238 TYPE(cp_iteration_info_type),
OPTIONAL,
POINTER :: iter_info
240 INTEGER :: output_unit
241 TYPE(cp_logger_type),
POINTER :: new_logger, old_logger
243 NULLIFY (new_logger, old_logger)
245 IF (para_env%is_source())
THEN
248 IF (output_path /=
"__STD_OUT__") &
249 CALL open_file(file_name=output_path, file_status=
"UNKNOWN", &
250 file_action=
"WRITE", file_position=
"APPEND", unit_number=output_unit)
255 default_global_unit_nr=output_unit, close_global_unit_on_dealloc=.false., &
256 template_logger=old_logger, iter_info=iter_info)
260 END SUBROUTINE error_add_new_logger
270 TYPE(section_vals_type),
POINTER :: root_section
273 CALL logger_finalize(
swarm_mpi, root_section)
287 SUBROUTINE logger_finalize(swarm_mpi, root_section)
289 TYPE(section_vals_type),
POINTER :: root_section
291 INTEGER :: output_unit
292 TYPE(cp_logger_type),
POINTER :: logger, old_logger
294 NULLIFY (logger, old_logger)
296 output_unit = logger%default_local_unit_nr
305 c_val=old_logger%iter_info%project_name)
311 output_unit = old_logger%default_local_unit_nr
312 OPEN (unit=output_unit, file=
swarm_mpi%master_output_path, &
313 status=
"UNKNOWN", action=
"WRITE", position=
"APPEND")
315 END SUBROUTINE logger_finalize
325 TYPE(swarm_message_type) :: report
347 TYPE(swarm_message_type),
INTENT(OUT) :: report
366 TYPE(swarm_message_type) :: cmd
368 INTEGER :: dest, tag, worker_id
370 CALL swarm_message_get(cmd,
"worker_id", worker_id)
386 TYPE(swarm_message_type),
INTENT(OUT) :: cmd
Utility routines to open and close files. Tracking of preconnections.
subroutine, public open_file(file_name, file_status, file_form, file_action, file_position, file_pad, unit_number, debug, skip_get_unit_number, file_access)
Opens the requested file using a free unit number.
subroutine, public close_file(unit_number, file_status, keep_preconnection)
Close an open file given by its logical unit number. Optionally, keep the file and unit preconnected.
Collection of routines to handle the iteration info.
pure subroutine, public cp_iteration_info_create(iteration_info, project_name)
creates an output info object
subroutine, public cp_iteration_info_release(iteration_info)
releases the iteration_info (see doc/ReferenceCounting.html)
various routines to log and control the output. The idea is that decisions about where to log should ...
subroutine, public cp_rm_default_logger()
the cousin of cp_add_default_logger, decrements the stack, so that the default logger is what it has ...
subroutine, public cp_logger_release(logger)
releases this logger
subroutine, public cp_logger_create(logger, para_env, print_level, default_global_unit_nr, default_local_unit_nr, global_filename, local_filename, close_global_unit_on_dealloc, iter_info, close_local_unit_on_dealloc, suffix, template_logger)
initializes a logger
subroutine, public cp_add_default_logger(logger)
adds a default logger. MUST be called before logging occours
type(cp_logger_type) function, pointer, public cp_get_default_logger()
returns the default logger
Defines the basic variable types.
integer, parameter, public default_string_length
integer, parameter, public default_path_length
Machine interface based on Fortran 2003 and POSIX.
integer, parameter, public default_output_unit
Interface to the message passing library MPI.
subroutine, public mp_para_env_release(para_env)
releases the para object (to be called when you don't want anymore the shared copy of this object)
integer, parameter, public mp_any_source
Swarm-message, a convenient data-container for with build-in serialization.
subroutine, public swarm_message_mpi_send(msg, group, dest, tag)
Sends a swarm message via MPI.
subroutine, public swarm_message_mpi_bcast(msg, src, group)
Broadcasts a swarm message via MPI.
subroutine, public swarm_message_mpi_recv(msg, group, src, tag)
Receives a swarm message via MPI.
Handles the MPI communication of the swarm framework.
subroutine, public swarm_mpi_init(swarm_mpi, world_para_env, root_section, n_workers, worker_id, iw)
Initialize MPI communicators for a swarm run.
subroutine, public swarm_mpi_send_command(swarm_mpi, cmd)
Sends a command via MPI.
subroutine, public swarm_mpi_recv_report(swarm_mpi, report)
Receives a report via MPI.
subroutine, public swarm_mpi_recv_command(swarm_mpi, cmd)
Receives a command via MPI and broadcasts it within a worker.
subroutine, public swarm_mpi_send_report(swarm_mpi, report)
Sends a report via MPI.
subroutine, public swarm_mpi_finalize(swarm_mpi, root_section)
Finalizes the MPI communicators of a swarm run.