1 |
module status |
2 |
use file_units, ONLY : next_unit |
3 |
use io_units, ONLY : input_unit,error_unit,output_unit |
4 |
use definitions, ONLY : DP, machdep_lnblnk |
5 |
use parameter, ONLY : file_prefix,paramfile,command,force_field,target_temp, & |
6 |
run_time,dt,skin_thickness,therm_variance,check_temp_steps,newtons_thrd |
7 |
use simulation, ONLY : force_time,comm_time |
8 |
#ifdef MPI |
9 |
use mpi_module |
10 |
#endif |
11 |
IMPLICIT NONE |
12 |
PRIVATE |
13 |
|
14 |
public :: dump_info |
15 |
public :: init_info |
16 |
public :: start_info |
17 |
public :: end_info |
18 |
public :: error |
19 |
public :: info |
20 |
public :: warning |
21 |
#ifdef MPI |
22 |
public :: mpi_start_info |
23 |
#endif |
24 |
|
25 |
|
26 |
|
27 |
integer :: info_unit |
28 |
character(len=80) :: info_file |
29 |
|
30 |
|
31 |
|
32 |
contains |
33 |
|
34 |
subroutine init_info(this_error) |
35 |
character(len=80) :: msg |
36 |
integer :: err |
37 |
integer, intent(out),optional :: this_error |
38 |
|
39 |
! . Check that we are node 0 if we are trying to do io |
40 |
#ifdef MPI |
41 |
if ( node /= 0 ) then |
42 |
return |
43 |
endif |
44 |
#endif |
45 |
info_file = file_prefix(1:machdep_lnblnk(file_prefix)) // '.info' |
46 |
info_unit = next_unit() |
47 |
open(file=info_file, unit=info_unit, status='replace', iostat= err, & |
48 |
action='write') |
49 |
if (err > 0) then |
50 |
write(error_unit,*) "Error opening info file", trim(info_file) |
51 |
if (present(this_error)) this_error = -1 |
52 |
end if |
53 |
write(output_unit,*) 'Info will be in: ', trim(info_file) |
54 |
|
55 |
end subroutine init_info |
56 |
|
57 |
subroutine dump_info(routine, error_msg) |
58 |
use definitions, ONLY : machdep_flush |
59 |
character(len=*), intent(in) :: routine, error_msg |
60 |
logical :: write_me |
61 |
integer :: len_msg |
62 |
integer :: len_routine |
63 |
len_msg = len_trim( error_msg ) |
64 |
len_routine = len_trim( routine ) |
65 |
|
66 |
#ifdef MPI |
67 |
if (node == 0) then |
68 |
#endif |
69 |
|
70 |
|
71 |
|
72 |
!! test to see if info_unit was opened, if it wasn't don't do |
73 |
!! anything stupid like trying to write to it. |
74 |
inquire(file=info_file,opened=write_me) |
75 |
if(write_me) then |
76 |
write(unit = info_unit,fmt="(/A)") "# INFO(" & |
77 |
// routine(1:len_routine) // "): " // error_msg(1:len_msg) |
78 |
call machdep_flush(info_unit) |
79 |
endif |
80 |
|
81 |
#ifdef MPI |
82 |
endif |
83 |
#endif |
84 |
end subroutine dump_info |
85 |
|
86 |
|
87 |
|
88 |
|
89 |
subroutine start_info(prog_name) |
90 |
use definitions, ONLY : clock, date, hostnam |
91 |
integer :: error_stat |
92 |
|
93 |
character(len=*), intent(in) :: prog_name |
94 |
|
95 |
character(len=30) :: my_name |
96 |
character(len=120) :: msg |
97 |
character(len=9) :: datestr |
98 |
character(len=8) :: clockstr |
99 |
#ifdef MPI |
100 |
integer :: my_name_length |
101 |
integer :: msg_size |
102 |
integer :: processor |
103 |
integer, dimension(mpi_status_size) :: istatus |
104 |
character(len=120) :: send_buffer |
105 |
character(len=120) :: recv_buffer |
106 |
|
107 |
#endif |
108 |
|
109 |
#ifndef MPI |
110 |
! get info |
111 |
call date(datestr) |
112 |
clockstr = clock() |
113 |
error_stat = hostnam(my_name) |
114 |
my_name = trim(my_name) |
115 |
|
116 |
write(msg,*) "Progam ", prog_name |
117 |
call info("PROGRAM_INFO",msg) |
118 |
write(msg,*) "Started ", datestr,clockstr, "on host ", my_name |
119 |
call info("PROGRAM_INFO",msg) |
120 |
|
121 |
#else |
122 |
call MPI_GET_PROCESSOR_NAME(my_name, my_name_length,mpi_err) |
123 |
|
124 |
my_name = trim(my_name) |
125 |
|
126 |
write(send_buffer,"(a6,i3,a4,i3,a4,a30,a9)") & |
127 |
" Node ", node, " of ", nprocs, " on ", my_name, " is alive" |
128 |
msg_size = len(send_buffer) |
129 |
|
130 |
if (node /= 0 ) then |
131 |
call MPI_Send (send_buffer, 120 , MPI_CHARACTER, & |
132 |
0, 0, MPI_COMM_WORLD, mpi_err) |
133 |
if (mpi_err /= 0) then |
134 |
call error("START_INFO","Error sending node name") |
135 |
endif |
136 |
|
137 |
|
138 |
else |
139 |
call info("PROGRAM_INFO",send_buffer) |
140 |
do processor = 1, nprocs - 1 |
141 |
call mpi_recv(recv_buffer, 120, mpi_character, processor, 0, & |
142 |
mpi_comm_world,istatus,mpi_err) |
143 |
if (mpi_err /= 0) then |
144 |
call error("START_INFO","Error receiving node name") |
145 |
endif |
146 |
call info("PROGRAM_INFO", recv_buffer) |
147 |
end do |
148 |
end if |
149 |
|
150 |
#endif |
151 |
|
152 |
#ifdef MPI |
153 |
if (node == 0) then |
154 |
write(msg,*) "Using MPI interface" |
155 |
call info("PROGRAM_INFO",msg) |
156 |
#endif |
157 |
|
158 |
write(msg,*) "The following parameters are being used..." |
159 |
call info("PROGRAM_INFO",msg) |
160 |
write(msg,'(a18,a52)') 'paramfile = ', paramfile |
161 |
call info("PROGRAM_INFO",msg) |
162 |
write(msg,'(a18,a52)') 'file_prefix = ', file_prefix |
163 |
call info("PROGRAM_INFO",msg) |
164 |
write(msg,'(a18,a52)') 'command = ', command |
165 |
call info("PROGRAM_INFO",msg) |
166 |
write(msg,'(a18,a52)') 'force field = ', force_field |
167 |
call info("PROGRAM_INFO",msg) |
168 |
write(msg,'(a18,es12.3,a2)') 'target_temp = ', target_temp, & |
169 |
' K' |
170 |
call info("PROGRAM_INFO",msg) |
171 |
write(msg,'(a18,es12.3,a13)') 'run_time = ', run_time, & |
172 |
' femtoseconds' |
173 |
call info("PROGRAM_INFO",msg) |
174 |
write(msg,'(a18,es12.3,a13)') & |
175 |
'dt = ', dt , ' femtoseconds' |
176 |
call info("PROGRAM_INFO",msg) |
177 |
write(msg,'(a18,es12.3,a10)') & |
178 |
'skin_thickness = ', skin_thickness, ' angstroms' |
179 |
call info("PROGRAM_INFO",msg) |
180 |
write(msg,'(a18,es12.3,a2)') & |
181 |
'thrm_variance = ', therm_variance, ' K' |
182 |
call info("PROGRAM_INFO",msg) |
183 |
write(msg,'(a18,i11)') & |
184 |
'chcktempsteps = ', check_temp_steps |
185 |
call info("PROGRAM_INFO",msg) |
186 |
#ifdef MPI |
187 |
if (newtons_thrd) then |
188 |
write(msg,'(a27)') "MPI using newtons third law" |
189 |
call info("PROGRAM_INFO",msg) |
190 |
else |
191 |
write(msg,'(a38)') "MPI Calculating all pairs explicitly." |
192 |
call info("PROGRAM_INFO",msg) |
193 |
endif |
194 |
endif |
195 |
#endif |
196 |
|
197 |
|
198 |
end subroutine start_info |
199 |
|
200 |
subroutine end_info |
201 |
use definitions, ONLY : clock,date |
202 |
character(len=9) :: datestr |
203 |
character(len=8) :: clockstr |
204 |
character(len=80) :: msg |
205 |
|
206 |
#ifdef MPI |
207 |
if (node == 0) then |
208 |
#endif |
209 |
call date(datestr) |
210 |
clockstr = clock() |
211 |
write(msg,*) "Finished Calculations on ", datestr,clockstr |
212 |
call info("PROGRAM_INFO",msg) |
213 |
#ifdef MPI |
214 |
endif |
215 |
#endif |
216 |
#ifndef MPI |
217 |
write(msg,*) "Total CPU time spent in force calculation: ", force_time |
218 |
call info("PROGRAM_INFO",msg) |
219 |
#else |
220 |
if (node == 0) then |
221 |
write(msg,*) "Total CPU time spent in force calculation: ", force_time |
222 |
call info("PROGRAM_INFO",msg) |
223 |
write(msg,*) "Total CPU time spent in communication: ", comm_time |
224 |
call info("PROGRAM_INFO",msg) |
225 |
end if |
226 |
|
227 |
#endif |
228 |
|
229 |
|
230 |
end subroutine end_info |
231 |
|
232 |
#ifdef MPI |
233 |
subroutine mpi_start_info() |
234 |
integer :: my_column_rank |
235 |
integer :: my_row_rank |
236 |
integer :: i |
237 |
integer :: this_rows_atoms |
238 |
integer :: this_cols_atoms |
239 |
integer :: processor |
240 |
integer, dimension(mpi_status_size) :: istatus |
241 |
character(Len=80) :: msg |
242 |
|
243 |
this_rows_atoms = 0 |
244 |
this_cols_atoms = 0 |
245 |
|
246 |
if (node == 0) then |
247 |
call info('SETUP_PARALLEL_MPI',"Partitioning of procs: ") |
248 |
write(msg,'(a26,i5)') "Number of Rows = ", & |
249 |
number_of_rows |
250 |
call info('SETUP_PARALLEL_MPI',trim(msg)) |
251 |
write(msg,'(a26,i5)') "Number of Columns = ", number_of_cols |
252 |
call info('SETUP_PARALLEL_MPI',trim(msg)) |
253 |
|
254 |
write(msg,'(a26,i5)') "Max Number of Molecules = ", maxmol_local |
255 |
call info('SETUP_PARALLEL_MPI',trim(msg)) |
256 |
write(msg,'(a26,i5)') "Max Number of Column Atoms = ", max_col |
257 |
call info('SETUP_PARALLEL_MPI',trim(msg)) |
258 |
write(msg,'(a26,i5)') "Max Number of Row Atoms = ", max_row |
259 |
call info('SETUP_PARALLEL_MPI',trim(msg)) |
260 |
write(msg,'(a26,i5)') "Max Number of Local Atoms = ", max_local |
261 |
call info('SETUP_PARALLEL_MPI',trim(msg)) |
262 |
|
263 |
call info('SETUP_PARALLEL_MPI',"Particle partitioning: ") |
264 |
endif |
265 |
|
266 |
call mpi_comm_rank(row_comm, my_row_rank,mpi_err) |
267 |
call mpi_comm_rank(col_comm, my_column_rank,mpi_err) |
268 |
|
269 |
!! Handle rows first |
270 |
|
271 |
if (node == 0) then |
272 |
call info('SETUP_PARALLEL_MPI',"Row particles...") |
273 |
write(msg,'(a4,i3,a10,i5,a6)') "Row ", 0," Contains ", nrow & |
274 |
," Atoms" |
275 |
call info('SETUP_PARALLEL_MPI',msg) |
276 |
do processor = 1, number_of_rows - 1 |
277 |
call mpi_recv(this_rows_atoms, 1, mpi_integer, MPI_ANY_SOURCE,10, & |
278 |
mpi_comm_world,istatus,mpi_err) |
279 |
write(msg,'(a4,i3,a10,i5,a6)') "Row ", processor," Contains ",this_rows_atoms & |
280 |
," Atoms" |
281 |
call info('SETUP_PARALLEL_MPI',trim(msg)) |
282 |
end do |
283 |
else |
284 |
if (my_row_rank == 0) then |
285 |
call mpi_send(nrow,1,mpi_integer,0,10, & |
286 |
mpi_comm_world,mpi_err) |
287 |
if (mpi_err /= 0) then |
288 |
call error("MPI_START_INFO","Error sending nrow") |
289 |
endif |
290 |
endif |
291 |
endif |
292 |
|
293 |
|
294 |
call mpi_barrier(mpi_comm_world,mpi_err) |
295 |
|
296 |
!! Now do the columns |
297 |
|
298 |
|
299 |
|
300 |
if (node == 0) then |
301 |
call info('SETUP_PARALLEL_MPI',"Column Particles...") |
302 |
write(msg,'(a7,i3,a10,i5,a6)') "Column ", 0," Contains ", ncol & |
303 |
," Atoms" |
304 |
call info('SETUP_PARALLEL_MPI',msg) |
305 |
do processor = 1, number_of_cols - 1 |
306 |
call mpi_recv(this_cols_atoms, 1, mpi_integer, MPI_ANY_SOURCE,12, & |
307 |
mpi_comm_world,istatus,mpi_err) |
308 |
write(msg,'(a7,i3,a10,i5,a6)') "Column ", processor ," Contains ",this_cols_atoms & |
309 |
," Atoms" |
310 |
call info('SETUP_PARALLEL_MPI',trim(msg)) |
311 |
end do |
312 |
else |
313 |
if (my_column_rank == 0) then |
314 |
call mpi_send(ncol,1,mpi_integer,0,12, & |
315 |
mpi_comm_world,mpi_err) |
316 |
if (mpi_err /= 0) then |
317 |
call error("MPI_START_INFO","Error sending ncol") |
318 |
endif |
319 |
endif |
320 |
end if |
321 |
|
322 |
call mpi_barrier(mpi_comm_world,mpi_err) |
323 |
|
324 |
end subroutine mpi_start_info |
325 |
#endif |
326 |
|
327 |
subroutine error(routine, error_msg, code) |
328 |
|
329 |
! message arguments |
330 |
character(len=*), intent(in) :: routine, error_msg |
331 |
! optional arguments |
332 |
integer, intent(in), optional :: code |
333 |
! local scalar |
334 |
|
335 |
integer :: len_msg |
336 |
integer :: len_routine |
337 |
|
338 |
len_msg = len_trim( error_msg ) |
339 |
len_routine = len_trim( routine ) |
340 |
|
341 |
#ifdef MPI |
342 |
if (node == 0) then |
343 |
#endif |
344 |
write(unit = error_unit,fmt="(/A)") "# ERROR in(" // & |
345 |
routine(1:len_routine) // "):" |
346 |
write(unit = error_unit,fmt = "(A)") error_msg(1:len_msg) |
347 |
|
348 |
if (present (code) ) & |
349 |
write(unit = error_unit,fmt = "(A,I6)") "Error code = ", code |
350 |
#ifdef MPI |
351 |
endif |
352 |
call mpi_finalize(mpi_err) |
353 |
if (node == 0) & |
354 |
#endif |
355 |
write(unit = error_unit,fmt = "(/A)") "Program halted" |
356 |
stop |
357 |
|
358 |
end subroutine error |
359 |
|
360 |
subroutine warning(routine, message) |
361 |
|
362 |
character(len=*), intent(in) :: routine |
363 |
character(len=*), intent(in) :: message |
364 |
|
365 |
integer :: len_msg |
366 |
integer :: len_routine |
367 |
|
368 |
len_msg = len_trim( message ) |
369 |
len_routine = len_trim( routine ) |
370 |
|
371 |
|
372 |
#ifdef MPI |
373 |
if (node == 0) then |
374 |
#endif |
375 |
write(unit = error_unit,fmt="(/A)") "# Warning in(" // & |
376 |
routine(1:len_routine) // "):" |
377 |
write(unit = error_unit,fmt = "(A)") message(1:len_msg) |
378 |
|
379 |
#ifdef MPI |
380 |
endif |
381 |
#endif |
382 |
end subroutine warning |
383 |
|
384 |
subroutine info(routine, message) |
385 |
character(len=*), intent(in) :: routine |
386 |
character(len=*), intent(in) :: message |
387 |
|
388 |
integer :: len_msg |
389 |
integer :: len_routine |
390 |
logical :: write_me |
391 |
|
392 |
len_msg = len_trim( message ) |
393 |
len_routine = len_trim( routine ) |
394 |
|
395 |
#ifdef MPI |
396 |
if (node == 0) then |
397 |
#endif |
398 |
write(unit = output_unit,fmt="(/A)") "# INFO(" & |
399 |
// routine(1:len_routine) // "): " // message(1:len_msg) |
400 |
|
401 |
inquire(file=info_file,opened=write_me) |
402 |
if(write_me) then |
403 |
call dump_info(routine,message) |
404 |
end if |
405 |
|
406 |
#ifdef MPI |
407 |
endif |
408 |
#endif |
409 |
end subroutine info |
410 |
|
411 |
end module status |
412 |
|
413 |
|
414 |
|