1 |
chuckv |
4 |
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 |
|
|
|