(git:42db5d2)
Loading...
Searching...
No Matches
realspace_grid_cube.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: GPL-2.0-or-later !
6!--------------------------------------------------------------------------------------------------!
7
8! **************************************************************************************************
9!> \brief Generate Gaussian cube files
10! **************************************************************************************************
11MODULE realspace_grid_cube
12 USE cp_files, ONLY: close_file,&
13 open_file
14 USE cp_log_handling, ONLY: cp_logger_get_default_io_unit
15 USE kinds, ONLY: dp
16 USE message_passing, ONLY: &
17 file_amode_rdonly, file_offset, mp_comm_type, mp_file_descriptor_type, mp_file_type, &
18 mp_file_type_free, mp_file_type_hindexed_make_chv, mp_file_type_set_view_chv, &
19 mpi_character_size
20 USE pw_grid_types, ONLY: pw_mode_local
21 USE pw_types, ONLY: pw_r3d_rs_type
22#include "../base/base_uses.f90"
23
24 IMPLICIT NONE
25
26 PRIVATE
27
28 PUBLIC :: cube_read_values, cube_value_format, cube_values_format, cube_to_pw, pw_to_cube, &
29 pw_to_simple_volumetric
30
31 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'realspace_grid_cube'
32 INTEGER, PARAMETER, PRIVATE :: cube_entry_len = 13, &
33 cube_num_entries_line = 6
34 INTEGER, PARAMETER, PRIVATE :: cube_line_len = cube_entry_len*cube_num_entries_line
35 CHARACTER(len=*), PARAMETER :: cube_value_format = '(1X,ES12.4E3)', &
36 cube_values_format = '(6(1X,ES12.4E3))'
37 LOGICAL, PARAMETER, PRIVATE :: debug_this_module = .false.
38
39CONTAINS
40
41! **************************************************************************************************
42!> \brief Read cube values from a character buffer.
43!> \param values value buffer from one cube line or one z-slice
44!> \param buffer parsed values
45! **************************************************************************************************
46 SUBROUTINE cube_read_values(values, buffer)
47 CHARACTER(LEN=*), INTENT(IN) :: values
48 REAL(kind=dp), DIMENSION(:), INTENT(OUT) :: buffer
49
50 CHARACTER(LEN=cube_entry_len) :: value
51 INTEGER :: i, pos, readstat
52
53 READ (values, *, iostat=readstat) buffer
54 IF (readstat == 0) RETURN
55
56 pos = 1
57 DO i = 1, SIZE(buffer)
58 IF (pos + cube_entry_len - 1 > len(values)) cpabort("Unexpected end of cube data.")
59 value = values(pos:pos + cube_entry_len - 1)
60 READ (value, '(E13.5)', iostat=readstat) buffer(i)
61 IF (readstat /= 0) cpabort("Bad value while reading cube data.")
62 pos = pos + cube_entry_len
63 IF (modulo(i, cube_num_entries_line) == 0) THEN
64 IF (pos <= len(values)) THEN
65 IF (values(pos:pos) == new_line('C')) pos = pos + 1
66 END IF
67 END IF
68 END DO
69
70 END SUBROUTINE cube_read_values
71
72! **************************************************************************************************
73!> \brief ...
74!> \param pw ...
75!> \param unit_nr ...
76!> \param title ...
77!> \param particles_r ...
78!> \param particles_z ...
79!> \param particles_zeff ...
80!> \param stride ...
81!> \param max_file_size_mb ...
82!> \param zero_tails ...
83!> \param silent ...
84!> \param mpi_io ...
85! **************************************************************************************************
86 SUBROUTINE pw_to_cube(pw, unit_nr, title, particles_r, particles_z, particles_zeff, &
87 stride, max_file_size_mb, zero_tails, silent, mpi_io)
88 TYPE(pw_r3d_rs_type), INTENT(IN) :: pw
89 INTEGER, INTENT(IN) :: unit_nr
90 CHARACTER(*), INTENT(IN), OPTIONAL :: title
91 REAL(kind=dp), DIMENSION(:, :), INTENT(IN), &
92 OPTIONAL :: particles_r
93 INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: particles_z
94 REAL(kind=dp), DIMENSION(:), INTENT(IN), OPTIONAL :: particles_zeff
95 INTEGER, DIMENSION(:), OPTIONAL, POINTER :: stride
96 REAL(kind=dp), INTENT(IN), OPTIONAL :: max_file_size_mb
97 LOGICAL, INTENT(IN), OPTIONAL :: zero_tails, silent, mpi_io
98
99 CHARACTER(len=*), PARAMETER :: routinen = 'pw_to_cube'
100 INTEGER, PARAMETER :: entry_len = 13, num_entries_line = 6
101
102 INTEGER :: checksum, dest, handle, i, i1, i2, i3, iat, ip, l1, l2, l3, msglen, my_rank, &
103 my_stride(3), np, num_linebreak, num_pe, rank(2), size_of_z, source, tag, u1, u2, u3
104 LOGICAL :: be_silent, my_zero_tails, parallel_write
105 REAL(kind=dp) :: compression_factor, my_max_file_size_mb
106 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: buf
107 TYPE(mp_comm_type) :: gid
108 TYPE(mp_file_type) :: mp_unit
109
110 CALL timeset(routinen, handle)
111
112 my_zero_tails = .false.
113 be_silent = .false.
114 parallel_write = .false.
115 my_max_file_size_mb = 0.0_dp
116 IF (PRESENT(zero_tails)) my_zero_tails = zero_tails
117 IF (PRESENT(silent)) be_silent = silent
118 IF (PRESENT(mpi_io)) parallel_write = mpi_io
119 IF (PRESENT(max_file_size_mb)) my_max_file_size_mb = max_file_size_mb
120 cpassert(my_max_file_size_mb >= 0)
121
122 my_stride = 1
123 IF (PRESENT(stride)) THEN
124 IF (SIZE(stride) /= 1 .AND. SIZE(stride) /= 3) THEN
125 CALL cp_abort(__location__, "STRIDE keyword can accept only 1 "// &
126 "(the same for X,Y,Z) or 3 values. Correct your input file.")
127 END IF
128 IF (SIZE(stride) == 1) THEN
129 DO i = 1, 3
130 my_stride(i) = stride(1)
131 END DO
132 ELSE
133 my_stride = stride(1:3)
134 END IF
135 END IF
136
137 IF (my_max_file_size_mb > 0) THEN
138 ! A single grid point takes up 13 bytes, which is 1.3e-05 MB.
139 compression_factor = 1.3e-05_dp*product(real(pw%pw_grid%npts, dp))/max_file_size_mb
140 my_stride(:) = int(compression_factor**(1.0/3.0)) + 1
141 END IF
142
143 cpassert(my_stride(1) > 0)
144 cpassert(my_stride(2) > 0)
145 cpassert(my_stride(3) > 0)
146
147 IF (.NOT. parallel_write) THEN
148 IF (unit_nr > 0) THEN
149 ! this format seems to work for e.g. molekel and gOpenmol
150 ! latest version of VMD can read non orthorhombic cells
151 WRITE (unit_nr, '(a11)') "-Quickstep-"
152 IF (PRESENT(title)) THEN
153 WRITE (unit_nr, *) trim(title)
154 ELSE
155 WRITE (unit_nr, *) "No Title"
156 END IF
157
158 cpassert(PRESENT(particles_z) .EQV. PRESENT(particles_r))
159 np = 0
160 IF (PRESENT(particles_z)) THEN
161 cpassert(SIZE(particles_z) == SIZE(particles_r, dim=2))
162 ! cube files can only be written for 99999 particles due to a format limitation (I5)
163 ! so we limit the number of particles written.
164 np = min(99999, SIZE(particles_z))
165 END IF
166
167 WRITE (unit_nr, '(I5,3f12.6)') np, 0.0_dp, 0._dp, 0._dp !start of cube
168
169 WRITE (unit_nr, '(I5,3f12.6)') (pw%pw_grid%npts(1) + my_stride(1) - 1)/my_stride(1), &
170 pw%pw_grid%dh(1, 1)*real(my_stride(1), dp), pw%pw_grid%dh(2, 1)*real(my_stride(1), dp), &
171 pw%pw_grid%dh(3, 1)*real(my_stride(1), dp)
172 WRITE (unit_nr, '(I5,3f12.6)') (pw%pw_grid%npts(2) + my_stride(2) - 1)/my_stride(2), &
173 pw%pw_grid%dh(1, 2)*real(my_stride(2), dp), pw%pw_grid%dh(2, 2)*real(my_stride(2), dp), &
174 pw%pw_grid%dh(3, 2)*real(my_stride(2), dp)
175 WRITE (unit_nr, '(I5,3f12.6)') (pw%pw_grid%npts(3) + my_stride(3) - 1)/my_stride(3), &
176 pw%pw_grid%dh(1, 3)*real(my_stride(3), dp), pw%pw_grid%dh(2, 3)*real(my_stride(3), dp), &
177 pw%pw_grid%dh(3, 3)*real(my_stride(3), dp)
178
179 IF (PRESENT(particles_z)) THEN
180 IF (PRESENT(particles_zeff)) THEN
181 DO iat = 1, np
182 WRITE (unit_nr, '(I5,4f12.6)') particles_z(iat), particles_zeff(iat), particles_r(:, iat)
183 END DO
184 ELSE
185 DO iat = 1, np
186 WRITE (unit_nr, '(I5,4f12.6)') particles_z(iat), 0._dp, particles_r(:, iat)
187 END DO
188 END IF
189 END IF
190 END IF
191
192 ! shortcut
193 l1 = pw%pw_grid%bounds(1, 1)
194 l2 = pw%pw_grid%bounds(1, 2)
195 l3 = pw%pw_grid%bounds(1, 3)
196 u1 = pw%pw_grid%bounds(2, 1)
197 u2 = pw%pw_grid%bounds(2, 2)
198 u3 = pw%pw_grid%bounds(2, 3)
199
200 ALLOCATE (buf(l3:u3))
201
202 my_rank = pw%pw_grid%para%group%mepos
203 gid = pw%pw_grid%para%group
204 num_pe = pw%pw_grid%para%group%num_pe
205 tag = 1
206
207 rank(1) = unit_nr
208 rank(2) = my_rank
209 checksum = 0
210 IF (unit_nr > 0) checksum = 1
211
212 CALL gid%sum(checksum)
213 cpassert(checksum == 1)
214
215 CALL gid%maxloc(rank)
216 cpassert(rank(1) > 0)
217
218 dest = rank(2)
219 DO i1 = l1, u1, my_stride(1)
220 DO i2 = l2, u2, my_stride(2)
221
222 ! cycling through the CPUs, check if the current ray (I1,I2) is local to that CPU
223 IF (pw%pw_grid%para%mode /= pw_mode_local) THEN
224 DO ip = 0, num_pe - 1
225 IF (pw%pw_grid%para%bo(1, 1, ip, 1) <= i1 - l1 + 1 .AND. pw%pw_grid%para%bo(2, 1, ip, 1) >= i1 - l1 + 1 .AND. &
226 pw%pw_grid%para%bo(1, 2, ip, 1) <= i2 - l2 + 1 .AND. pw%pw_grid%para%bo(2, 2, ip, 1) >= i2 - l2 + 1) THEN
227 source = ip
228 END IF
229 END DO
230 ELSE
231 source = dest
232 END IF
233
234 IF (source == dest) THEN
235 IF (my_rank == source) THEN
236 buf(:) = pw%array(i1, i2, :)
237 END IF
238 ELSE
239 IF (my_rank == source) THEN
240 buf(:) = pw%array(i1, i2, :)
241 CALL gid%send(buf, dest, tag)
242 END IF
243 IF (my_rank == dest) THEN
244 CALL gid%recv(buf, source, tag)
245 END IF
246 END IF
247
248 IF (unit_nr > 0) THEN
249 IF (my_zero_tails) THEN
250 DO i3 = l3, u3
251 IF (buf(i3) < 1.e-7_dp) buf(i3) = 0.0_dp
252 END DO
253 END IF
254 WRITE (unit_nr, cube_values_format) (buf(i3), i3=l3, u3, my_stride(3))
255 END IF
256
257 ! this double loop generates so many messages that it can overload
258 ! the message passing system, e.g. on XT3
259 ! we therefore put a barrier here that limits the amount of message
260 ! that flies around at any given time.
261 ! if ever this routine becomes a bottleneck, we should go for a
262 ! more complicated rewrite
263 CALL gid%sync()
264
265 END DO
266 END DO
267
268 DEALLOCATE (buf)
269 ELSE
270 size_of_z = ceiling(real(pw%pw_grid%bounds(2, 3) - pw%pw_grid%bounds(1, 3) + 1, dp)/real(my_stride(3), dp))
271 num_linebreak = size_of_z/num_entries_line
272 IF (modulo(size_of_z, num_entries_line) /= 0) THEN
273 num_linebreak = num_linebreak + 1
274 END IF
275 msglen = (size_of_z*entry_len + num_linebreak)*mpi_character_size
276 CALL mp_unit%set_handle(unit_nr)
277 CALL pw_to_cube_parallel(pw, mp_unit, title, particles_r, particles_z, particles_zeff, &
278 my_stride, my_zero_tails, msglen)
279 END IF
280
281 CALL timestop(handle)
282
283 END SUBROUTINE pw_to_cube
284
285! **************************************************************************************************
286!> \brief Computes the external density on the grid
287!> hacked from external_read_density
288!> \param grid pw to read from cube file
289!> \param filename name of cube file
290!> \param scaling scale values before storing
291!> \param parallel_read ...
292!> \param silent ...
293!> \par History
294!> Created [M.Watkins] (01.2014)
295!> Use blocking, collective MPI read for parallel simulations [Nico Holmberg] (05.2017)
296! **************************************************************************************************
297 SUBROUTINE cube_to_pw(grid, filename, scaling, parallel_read, silent)
298
299 TYPE(pw_r3d_rs_type), INTENT(IN) :: grid
300 CHARACTER(len=*), INTENT(in) :: filename
301 REAL(kind=dp), INTENT(in) :: scaling
302 LOGICAL, INTENT(in) :: parallel_read
303 LOGICAL, INTENT(in), OPTIONAL :: silent
304
305 CHARACTER(len=*), PARAMETER :: routinen = 'cube_to_pw'
306 INTEGER, PARAMETER :: entry_len = 13, num_entries_line = 6
307
308 CHARACTER(LEN=cube_line_len) :: value_line
309 INTEGER :: extunit, handle, i, j, k, last_z, &
310 msglen, my_rank, nat, ndum, &
311 num_linebreak, num_pe, output_unit, &
312 size_of_z, tag
313 INTEGER, DIMENSION(3) :: lbounds, lbounds_local, npoints, &
314 npoints_local, ubounds, ubounds_local
315 LOGICAL :: be_silent
316 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: buffer
317 REAL(kind=dp), DIMENSION(3) :: dr, rdum
318 TYPE(mp_comm_type) :: gid
319
320 output_unit = cp_logger_get_default_io_unit()
321
322 CALL timeset(routinen, handle)
323
324 be_silent = .false.
325 IF (PRESENT(silent)) THEN
326 be_silent = silent
327 END IF
328 !get rs grids and parallel environment
329 gid = grid%pw_grid%para%group
330 my_rank = grid%pw_grid%para%group%mepos
331 num_pe = grid%pw_grid%para%group%num_pe
332 tag = 1
333
334 lbounds_local = grid%pw_grid%bounds_local(1, :)
335 ubounds_local = grid%pw_grid%bounds_local(2, :)
336 size_of_z = ubounds_local(3) - lbounds_local(3) + 1
337
338 IF (.NOT. parallel_read) THEN
339 npoints = grid%pw_grid%npts
340 lbounds = grid%pw_grid%bounds(1, :)
341 ubounds = grid%pw_grid%bounds(2, :)
342
343 DO i = 1, 3
344 dr(i) = grid%pw_grid%dh(i, i)
345 END DO
346
347 npoints_local = grid%pw_grid%npts_local
348 !pw grids at most pencils - all processors have a full set of z data for x,y
349 ALLOCATE (buffer(lbounds(3):ubounds(3)))
350
351 IF (my_rank == 0) THEN
352 IF (output_unit > 0 .AND. .NOT. be_silent) THEN
353 WRITE (output_unit, fmt="(/,T2,A,/,/,T2,A,/)") "Reading the cube file: ", trim(filename)
354 END IF
355
356 CALL open_file(file_name=filename, &
357 file_status="OLD", &
358 file_form="FORMATTED", &
359 file_action="READ", &
360 unit_number=extunit)
361
362 !skip header comments
363 DO i = 1, 2
364 READ (extunit, *)
365 END DO
366 READ (extunit, *) nat, rdum
367 DO i = 1, 3
368 READ (extunit, *) ndum, rdum
369 IF ((ndum /= npoints(i) .OR. (abs(rdum(i) - dr(i)) > 1e-4)) .AND. &
370 output_unit > 0) THEN
371 WRITE (output_unit, *) "Restart from density | ERROR! | CUBE FILE NOT COINCIDENT WITH INTERNAL GRID ", i
372 WRITE (output_unit, *) "Restart from density | ", ndum, " DIFFERS FROM ", npoints(i)
373 WRITE (output_unit, *) "Restart from density | ", rdum, " DIFFERS FROM ", dr(i)
374 END IF
375 END DO
376 !ignore atomic position data - read from coord or topology instead
377 DO i = 1, nat
378 READ (extunit, *)
379 END DO
380 END IF
381
382 !master sends all data to everyone
383 DO i = lbounds(1), ubounds(1)
384 DO j = lbounds(2), ubounds(2)
385 IF (my_rank == 0) THEN
386 DO k = lbounds(3), ubounds(3), cube_num_entries_line
387 last_z = min(k + cube_num_entries_line - 1, ubounds(3))
388 READ (extunit, '(A)') value_line
389 CALL cube_read_values(value_line, buffer(k:last_z))
390 END DO
391 END IF
392 CALL gid%bcast(buffer(lbounds(3):ubounds(3)), 0)
393
394 !only use data that is local to me - i.e. in slice of pencil I own
395 IF ((lbounds_local(1) <= i) .AND. (i <= ubounds_local(1)) .AND. (lbounds_local(2) <= j) &
396 .AND. (j <= ubounds_local(2))) THEN
397 !allow scaling of external potential values by factor 'scaling' (SCALING_FACTOR in input file)
398 grid%array(i, j, lbounds(3):ubounds(3)) = buffer(lbounds(3):ubounds(3))*scaling
399 END IF
400
401 END DO
402 END DO
403
404 IF (my_rank == 0) CALL close_file(unit_number=extunit)
405
406 CALL gid%sync()
407 ELSE
408 ! Parallel routine needs as input the byte size of each grid z-slice
409 ! This is a hack to prevent compilation errors with gcc -Wall (up to versions 6.3)
410 ! related to allocatable-length string declaration CHARACTER(LEN=:), ALLOCATABLE, DIMENSION(:) :: string
411 ! Each data line of a Gaussian cube contains max 6 entries with last line potentially containing less if nz % 6 /= 0
412 ! Thus, this size is simply the number of entries multiplied by the entry size + the number of line breaks
413 num_linebreak = size_of_z/num_entries_line
414 IF (modulo(size_of_z, num_entries_line) /= 0) THEN
415 num_linebreak = num_linebreak + 1
416 END IF
417 msglen = (size_of_z*entry_len + num_linebreak)*mpi_character_size
418 CALL cube_to_pw_parallel(grid, filename, scaling, msglen, silent=silent)
419 END IF
420
421 CALL timestop(handle)
422
423 END SUBROUTINE cube_to_pw
424
425! **************************************************************************************************
426!> \brief Reads a realspace potential/density from a cube file using collective MPI I/O and
427!> stores it in grid.
428!> \param grid pw to read from cube file
429!> \param filename name of cube file
430!> \param scaling scale values before storing
431!> \param msglen the size of each grid slice along z-axis in bytes
432!> \param silent ...
433!> \par History
434!> Created [Nico Holmberg] (05.2017)
435! **************************************************************************************************
436 SUBROUTINE cube_to_pw_parallel(grid, filename, scaling, msglen, silent)
437
438 TYPE(pw_r3d_rs_type), INTENT(IN) :: grid
439 CHARACTER(len=*), INTENT(in) :: filename
440 REAL(kind=dp), INTENT(in) :: scaling
441 INTEGER, INTENT(in) :: msglen
442 LOGICAL, INTENT(in), OPTIONAL :: silent
443
444 CHARACTER(LEN=cube_line_len) :: value_line
445 INTEGER, DIMENSION(3) :: lbounds, lbounds_local, npoints, &
446 npoints_local, ubounds, ubounds_local
447 INTEGER, ALLOCATABLE, DIMENSION(:), TARGET :: blocklengths
448 INTEGER(kind=file_offset), ALLOCATABLE, &
449 DIMENSION(:), TARGET :: displacements
450 INTEGER(kind=file_offset) :: bof
451 INTEGER :: extunit_handle, i, islice, j, k, last_z, &
452 my_rank, nat, ndum, nslices, num_pe, &
453 offset_global, output_unit, size_of_z, &
454 tag
455 CHARACTER(LEN=msglen), ALLOCATABLE, DIMENSION(:) :: readbuffer
456 LOGICAL :: be_silent, should_read(2)
457 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: buffer
458 REAL(kind=dp), DIMENSION(3) :: dr, rdum
459 TYPE(mp_comm_type) :: gid
460 TYPE(mp_file_descriptor_type) :: mp_file_desc
461 TYPE(mp_file_type) :: extunit
462
463 output_unit = cp_logger_get_default_io_unit()
464
465 be_silent = .false.
466 IF (PRESENT(silent)) THEN
467 be_silent = silent
468 END IF
469
470 !get rs grids and parallel envnment
471 gid = grid%pw_grid%para%group
472 my_rank = grid%pw_grid%para%group%mepos
473 num_pe = grid%pw_grid%para%group%num_pe
474 tag = 1
475
476 DO i = 1, 3
477 dr(i) = grid%pw_grid%dh(i, i)
478 END DO
479
480 npoints = grid%pw_grid%npts
481 lbounds = grid%pw_grid%bounds(1, :)
482 ubounds = grid%pw_grid%bounds(2, :)
483
484 npoints_local = grid%pw_grid%npts_local
485 lbounds_local = grid%pw_grid%bounds_local(1, :)
486 ubounds_local = grid%pw_grid%bounds_local(2, :)
487 size_of_z = ubounds_local(3) - lbounds_local(3) + 1
488 nslices = (ubounds_local(1) - lbounds_local(1) + 1)*(ubounds_local(2) - lbounds_local(2) + 1)
489 islice = 1
490
491 ! Read header information and determine byte offset of cube data on master process
492 IF (my_rank == 0) THEN
493 IF (output_unit > 0 .AND. .NOT. be_silent) THEN
494 WRITE (output_unit, fmt="(/,T2,A,/,/,T2,A,/)") "Reading the cube file: ", trim(filename)
495 END IF
496
497 CALL open_file(file_name=filename, &
498 file_status="OLD", &
499 file_form="FORMATTED", &
500 file_action="READ", &
501 file_access="STREAM", &
502 unit_number=extunit_handle)
503
504 !skip header comments
505 DO i = 1, 2
506 READ (extunit_handle, *)
507 END DO
508 READ (extunit_handle, *) nat, rdum
509 DO i = 1, 3
510 READ (extunit_handle, *) ndum, rdum
511 IF ((ndum /= npoints(i) .OR. (abs(rdum(i) - dr(i)) > 1e-4)) .AND. &
512 output_unit > 0) THEN
513 WRITE (output_unit, *) "Restart from density | ERROR! | CUBE FILE NOT COINCIDENT WITH INTERNAL GRID ", i
514 WRITE (output_unit, *) "Restart from density | ", ndum, " DIFFERS FROM ", npoints(i)
515 WRITE (output_unit, *) "Restart from density | ", rdum, " DIFFERS FROM ", dr(i)
516 END IF
517 END DO
518 !ignore atomic position data - read from coord or topology instead
519 DO i = 1, nat
520 READ (extunit_handle, *)
521 END DO
522 ! Get byte offset
523 INQUIRE (extunit_handle, pos=offset_global)
524 CALL close_file(unit_number=extunit_handle)
525 END IF
526 ! Sync offset and start parallel read
527 CALL gid%bcast(offset_global, grid%pw_grid%para%group%source)
528 ! INQUIRE(POS=...) returns a 1-based stream position, whereas MPI-IO
529 ! file offsets are 0-based.
530 bof = offset_global - 1
531 CALL extunit%open(groupid=gid, filepath=filename, amode_status=file_amode_rdonly)
532 ! Determine byte offsets for each grid z-slice which are local to a process
533 ALLOCATE (displacements(nslices))
534 displacements = 0
535 DO i = lbounds(1), ubounds(1)
536 should_read(:) = .true.
537 IF (i < lbounds_local(1)) THEN
538 should_read(1) = .false.
539 ELSE IF (i > ubounds_local(1)) THEN
540 EXIT
541 END IF
542 DO j = lbounds(2), ubounds(2)
543 should_read(2) = .true.
544 IF (j < lbounds_local(2) .OR. j > ubounds_local(2)) THEN
545 should_read(2) = .false.
546 END IF
547 IF (all(should_read .EQV. .true.)) THEN
548 IF (islice > nslices) cpabort("Index out of bounds.")
549 displacements(islice) = bof
550 islice = islice + 1
551 END IF
552 ! Update global byte offset
553 bof = bof + msglen
554 END DO
555 END DO
556 ! Size of each z-slice is msglen
557 ALLOCATE (blocklengths(nslices))
558 blocklengths(:) = msglen
559 ! Create indexed MPI type using calculated byte offsets as displacements and use it as a file view
560 mp_file_desc = mp_file_type_hindexed_make_chv(nslices, blocklengths, displacements)
561 bof = 0
562 CALL mp_file_type_set_view_chv(extunit, bof, mp_file_desc)
563 ! Collective read of cube
564 ALLOCATE (readbuffer(nslices))
565 readbuffer(:) = ''
566 CALL extunit%read_all(msglen, nslices, readbuffer, mp_file_desc)
567 CALL mp_file_type_free(mp_file_desc)
568 CALL extunit%close()
569 ! Convert cube values string -> real
570 i = lbounds_local(1)
571 j = lbounds_local(2)
572 ALLOCATE (buffer(lbounds(3):ubounds(3)))
573 buffer = 0.0_dp
574 DO islice = 1, nslices
575 CALL cube_read_values(readbuffer(islice), buffer(lbounds(3):ubounds(3)))
576 ! Optionally scale cube file values
577 grid%array(i, j, lbounds(3):ubounds(3)) = scaling*buffer(lbounds(3):ubounds(3))
578 j = j + 1
579 IF (j > ubounds_local(2)) THEN
580 j = lbounds_local(2)
581 i = i + 1
582 END IF
583 END DO
584 DEALLOCATE (readbuffer)
585 DEALLOCATE (blocklengths, displacements)
586 IF (debug_this_module) THEN
587 ! Check that cube was correctly read using intrinsic read on master who sends data to everyone
588 buffer = 0.0_dp
589 IF (my_rank == 0) THEN
590 IF (output_unit > 0 .AND. .NOT. be_silent) THEN
591 WRITE (output_unit, fmt="(/,T2,A,/,/,T2,A)") "Reading the cube file: ", filename
592 END IF
593
594 CALL open_file(file_name=filename, &
595 file_status="OLD", &
596 file_form="FORMATTED", &
597 file_action="READ", &
598 unit_number=extunit_handle)
599
600 !skip header comments
601 DO i = 1, 2
602 READ (extunit_handle, *)
603 END DO
604 READ (extunit_handle, *) nat, rdum
605 DO i = 1, 3
606 READ (extunit_handle, *) ndum, rdum
607 IF ((ndum /= npoints(i) .OR. (abs(rdum(i) - dr(i)) > 1e-4)) .AND. &
608 output_unit > 0) THEN
609 WRITE (output_unit, *) "Restart from density | ERROR! | CUBE FILE NOT COINCIDENT WITH INTERNAL GRID ", i
610 WRITE (output_unit, *) "Restart from density | ", ndum, " DIFFERS FROM ", npoints(i)
611 WRITE (output_unit, *) "Restart from density | ", rdum, " DIFFERS FROM ", dr(i)
612 END IF
613 END DO
614 !ignore atomic position data - read from coord or topology instead
615 DO i = 1, nat
616 READ (extunit_handle, *)
617 END DO
618 END IF
619
620 !master sends all data to everyone
621 DO i = lbounds(1), ubounds(1)
622 DO j = lbounds(2), ubounds(2)
623 IF (my_rank == 0) THEN
624 DO k = lbounds(3), ubounds(3), cube_num_entries_line
625 last_z = min(k + cube_num_entries_line - 1, ubounds(3))
626 READ (extunit_handle, '(A)') value_line
627 CALL cube_read_values(value_line, buffer(k:last_z))
628 END DO
629 END IF
630 CALL gid%bcast(buffer(lbounds(3):ubounds(3)), 0)
631
632 !only use data that is local to me - i.e. in slice of pencil I own
633 IF ((lbounds_local(1) <= i) .AND. (i <= ubounds_local(1)) .AND. (lbounds_local(2) <= j) &
634 .AND. (j <= ubounds_local(2))) THEN
635 !allow scaling of external potential values by factor 'scaling' (SCALING_FACTOR in input file)
636 IF (any(grid%array(i, j, lbounds(3):ubounds(3)) /= buffer(lbounds(3):ubounds(3))*scaling)) THEN
637 CALL cp_abort(__location__, &
638 "Error in parallel read of input cube file.")
639 END IF
640 END IF
641
642 END DO
643 END DO
644
645 IF (my_rank == 0) CALL close_file(unit_number=extunit_handle)
646
647 CALL gid%sync()
648 END IF
649 DEALLOCATE (buffer)
650
651 END SUBROUTINE cube_to_pw_parallel
652
653! **************************************************************************************************
654!> \brief Writes a realspace potential to a cube file using collective MPI I/O.
655!> \param grid the pw to output to the cube file
656!> \param unit_nr the handle associated with the cube file
657!> \param title title of the cube file
658!> \param particles_r Cartersian coordinates of the system
659!> \param particles_z atomic masses of atoms in the system
660!> \param particles_zeff effective atomic charges of atoms in the system
661!> \param stride every stride(i)th value of the potential is outputted (i=x,y,z)
662!> \param zero_tails flag that determines if small values of the potential should be zeroed
663!> \param msglen the size of each grid slice along z-axis in bytes
664!> \par History
665!> Created [Nico Holmberg] (11.2017)
666! **************************************************************************************************
667 SUBROUTINE pw_to_cube_parallel(grid, unit_nr, title, particles_r, particles_z, particles_zeff, &
668 stride, zero_tails, msglen)
669
670 TYPE(pw_r3d_rs_type), INTENT(IN) :: grid
671 TYPE(mp_file_type), INTENT(IN) :: unit_nr
672 CHARACTER(*), INTENT(IN), OPTIONAL :: title
673 REAL(kind=dp), DIMENSION(:, :), INTENT(IN), &
674 OPTIONAL :: particles_r
675 INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: particles_z
676 REAL(kind=dp), DIMENSION(:), INTENT(IN), OPTIONAL :: particles_zeff
677 INTEGER, INTENT(IN) :: stride(3)
678 LOGICAL, INTENT(IN) :: zero_tails
679 INTEGER, INTENT(IN) :: msglen
680
681 INTEGER, PARAMETER :: entry_len = 13, header_len = 41, &
682 header_len_z = 53, num_entries_line = 6
683
684 CHARACTER(LEN=entry_len) :: value
685 CHARACTER(LEN=header_len) :: header
686 CHARACTER(LEN=header_len_z) :: header_z
687 INTEGER, DIMENSION(3) :: lbounds, lbounds_local, ubounds, &
688 ubounds_local
689 INTEGER, ALLOCATABLE, DIMENSION(:), TARGET :: blocklengths
690 INTEGER(kind=file_offset), ALLOCATABLE, &
691 DIMENSION(:), TARGET :: displacements
692 INTEGER(kind=file_offset) :: bof
693 INTEGER :: counter, i, islice, j, k, last_z, &
694 my_rank, np, nslices, size_of_z
695 CHARACTER(LEN=msglen), ALLOCATABLE, DIMENSION(:) :: writebuffer
696 CHARACTER(LEN=msglen) :: tmp
697 LOGICAL :: should_write(2)
698 TYPE(mp_comm_type) :: gid
699 TYPE(mp_file_descriptor_type) :: mp_desc
700
701 !get rs grids and parallel envnment
702 gid = grid%pw_grid%para%group
703 my_rank = grid%pw_grid%para%group%mepos
704
705 ! Shortcut
706 lbounds = grid%pw_grid%bounds(1, :)
707 ubounds = grid%pw_grid%bounds(2, :)
708 lbounds_local = grid%pw_grid%bounds_local(1, :)
709 ubounds_local = grid%pw_grid%bounds_local(2, :)
710 ! Determine the total number of z-slices and the number of values per slice
711 size_of_z = ceiling(real(ubounds_local(3) - lbounds_local(3) + 1, dp)/real(stride(3), dp))
712 islice = 1
713 DO i = lbounds(1), ubounds(1), stride(1)
714 should_write(:) = .true.
715 IF (i < lbounds_local(1)) THEN
716 should_write(1) = .false.
717 ELSE IF (i > ubounds_local(1)) THEN
718 EXIT
719 END IF
720 DO j = lbounds(2), ubounds(2), stride(2)
721 should_write(2) = .true.
722 IF (j < lbounds_local(2) .OR. j > ubounds_local(2)) THEN
723 should_write(2) = .false.
724 END IF
725 IF (all(should_write .EQV. .true.)) THEN
726 islice = islice + 1
727 END IF
728 END DO
729 END DO
730 nslices = islice - 1
731 DO k = lbounds(3), ubounds(3), stride(3)
732 IF (k + stride(3) > ubounds(3)) last_z = k
733 END DO
734 islice = 1
735 ! Determine initial byte offset (0 or EOF if data is appended)
736 CALL unit_nr%get_position(bof)
737 ! Write header information on master process and update byte offset accordingly
738 IF (my_rank == 0) THEN
739 ! this format seems to work for e.g. molekel and gOpenmol
740 ! latest version of VMD can read non orthorhombic cells
741 CALL unit_nr%write_at(bof, "-Quickstep-"//new_line("C"))
742 bof = bof + len("-Quickstep-"//new_line("C"))*mpi_character_size
743 IF (PRESENT(title)) THEN
744 CALL unit_nr%write_at(bof, trim(title)//new_line("C"))
745 bof = bof + len(trim(title)//new_line("C"))*mpi_character_size
746 ELSE
747 CALL unit_nr%write_at(bof, "No Title"//new_line("C"))
748 bof = bof + len("No Title"//new_line("C"))*mpi_character_size
749 END IF
750
751 cpassert(PRESENT(particles_z) .EQV. PRESENT(particles_r))
752 np = 0
753 IF (PRESENT(particles_z)) THEN
754 cpassert(SIZE(particles_z) == SIZE(particles_r, dim=2))
755 ! cube files can only be written for 99999 particles due to a format limitation (I5)
756 ! so we limit the number of particles written.
757 np = min(99999, SIZE(particles_z))
758 END IF
759
760 WRITE (header, '(I5,3f12.6)') np, 0.0_dp, 0._dp, 0._dp !start of cube
761 CALL unit_nr%write_at(bof, header//new_line("C"))
762 bof = bof + len(header//new_line("C"))*mpi_character_size
763
764 WRITE (header, '(I5,3f12.6)') (grid%pw_grid%npts(1) + stride(1) - 1)/stride(1), &
765 grid%pw_grid%dh(1, 1)*real(stride(1), dp), grid%pw_grid%dh(2, 1)*real(stride(1), dp), &
766 grid%pw_grid%dh(3, 1)*real(stride(1), dp)
767 CALL unit_nr%write_at(bof, header//new_line("C"))
768 bof = bof + len(header//new_line("C"))*mpi_character_size
769
770 WRITE (header, '(I5,3f12.6)') (grid%pw_grid%npts(2) + stride(2) - 1)/stride(2), &
771 grid%pw_grid%dh(1, 2)*real(stride(2), dp), grid%pw_grid%dh(2, 2)*real(stride(2), dp), &
772 grid%pw_grid%dh(3, 2)*real(stride(2), dp)
773 CALL unit_nr%write_at(bof, header//new_line("C"))
774 bof = bof + len(header//new_line("C"))*mpi_character_size
775
776 WRITE (header, '(I5,3f12.6)') (grid%pw_grid%npts(3) + stride(3) - 1)/stride(3), &
777 grid%pw_grid%dh(1, 3)*real(stride(3), dp), grid%pw_grid%dh(2, 3)*real(stride(3), dp), &
778 grid%pw_grid%dh(3, 3)*real(stride(3), dp)
779 CALL unit_nr%write_at(bof, header//new_line("C"))
780 bof = bof + len(header//new_line("C"))*mpi_character_size
781
782 IF (PRESENT(particles_z)) THEN
783 IF (PRESENT(particles_zeff)) THEN
784 DO i = 1, np
785 WRITE (header_z, '(I5,4f12.6)') particles_z(i), particles_zeff(i), particles_r(:, i)
786 CALL unit_nr%write_at(bof, header_z//new_line("C"))
787 bof = bof + len(header_z//new_line("C"))*mpi_character_size
788 END DO
789 ELSE
790 DO i = 1, np
791 WRITE (header_z, '(I5,4f12.6)') particles_z(i), 0._dp, particles_r(:, i)
792 CALL unit_nr%write_at(bof, header_z//new_line("C"))
793 bof = bof + len(header_z//new_line("C"))*mpi_character_size
794 END DO
795 END IF
796 END IF
797 END IF
798 ! Sync offset
799 CALL gid%bcast(bof, grid%pw_grid%para%group%source)
800 ! Determine byte offsets for each grid z-slice which are local to a process
801 ! and convert z-slices to cube format compatible strings
802 ALLOCATE (displacements(nslices))
803 displacements = 0
804 ALLOCATE (writebuffer(nslices))
805 writebuffer(:) = ''
806 DO i = lbounds(1), ubounds(1), stride(1)
807 should_write(:) = .true.
808 IF (i < lbounds_local(1)) THEN
809 should_write(1) = .false.
810 ELSE IF (i > ubounds_local(1)) THEN
811 EXIT
812 END IF
813 DO j = lbounds(2), ubounds(2), stride(2)
814 should_write(2) = .true.
815 IF (j < lbounds_local(2) .OR. j > ubounds_local(2)) THEN
816 should_write(2) = .false.
817 END IF
818 IF (all(should_write .EQV. .true.)) THEN
819 IF (islice > nslices) cpabort("Index out of bounds.")
820 displacements(islice) = bof
821 tmp = ''
822 counter = 0
823 DO k = lbounds(3), ubounds(3), stride(3)
824 IF (zero_tails .AND. grid%array(i, j, k) < 1.e-7_dp) THEN
825 WRITE (value, cube_value_format) 0.0_dp
826 ELSE
827 WRITE (value, cube_value_format) grid%array(i, j, k)
828 END IF
829 tmp = trim(tmp)//trim(value)
830 counter = counter + 1
831 IF (modulo(counter, num_entries_line) == 0 .OR. k == last_z) THEN
832 tmp = trim(tmp)//new_line('C')
833 END IF
834 END DO
835 writebuffer(islice) = tmp
836 islice = islice + 1
837 END IF
838 ! Update global byte offset
839 bof = bof + msglen
840 END DO
841 END DO
842 ! Create indexed MPI type using calculated byte offsets as displacements
843 ! Size of each z-slice is msglen
844 ALLOCATE (blocklengths(nslices))
845 blocklengths(:) = msglen
846 mp_desc = mp_file_type_hindexed_make_chv(nslices, blocklengths, displacements)
847 ! Use the created type as a file view
848 ! NB. The vector 'displacements' contains the absolute offsets of each z-slice i.e.
849 ! they are given relative to the beginning of the file. The global offset to
850 ! set_view must therefore be set to 0
851 bof = 0
852 CALL mp_file_type_set_view_chv(unit_nr, bof, mp_desc)
853 ! Collective write of cube
854 CALL unit_nr%write_all(msglen, nslices, writebuffer, mp_desc)
855 ! Clean up
856 CALL mp_file_type_free(mp_desc)
857 DEALLOCATE (writebuffer)
858 DEALLOCATE (blocklengths, displacements)
859
860 END SUBROUTINE pw_to_cube_parallel
861
862! **************************************************************************************************
863!> \brief Prints a simple grid file: X Y Z value
864!> \param pw ...
865!> \param unit_nr ...
866!> \param stride ...
867!> \param pw2 ...
868!> \par History
869!> Created [Vladimir Rybkin] (08.2018)
870!> \author Vladimir Rybkin
871! **************************************************************************************************
872 SUBROUTINE pw_to_simple_volumetric(pw, unit_nr, stride, pw2)
873 TYPE(pw_r3d_rs_type), INTENT(IN) :: pw
874 INTEGER, INTENT(IN) :: unit_nr
875 INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: stride
876 TYPE(pw_r3d_rs_type), INTENT(IN), OPTIONAL :: pw2
877
878 CHARACTER(len=*), PARAMETER :: routinen = 'pw_to_simple_volumetric'
879
880 INTEGER :: checksum, dest, handle, i, i1, i2, i3, &
881 ip, l1, l2, l3, my_rank, my_stride(3), &
882 ngrids, npoints, num_pe, rank(2), &
883 source, tag, u1, u2, u3
884 LOGICAL :: double
885 REAL(kind=dp) :: x, y, z
886 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: buf, buf2
887 TYPE(mp_comm_type) :: gid
888
889 CALL timeset(routinen, handle)
890
891 ! Check if we write two grids
892 double = .false.
893 IF (PRESENT(pw2)) double = .true.
894
895 my_stride = 1
896 IF (PRESENT(stride)) THEN
897 IF (SIZE(stride) /= 1 .AND. SIZE(stride) /= 3) THEN
898 CALL cp_abort(__location__, "STRIDE keyword can accept only 1 "// &
899 "(the same for X,Y,Z) or 3 values. Correct your input file.")
900 END IF
901 IF (SIZE(stride) == 1) THEN
902 DO i = 1, 3
903 my_stride(i) = stride(1)
904 END DO
905 ELSE
906 my_stride = stride(1:3)
907 END IF
908 cpassert(my_stride(1) > 0)
909 cpassert(my_stride(2) > 0)
910 cpassert(my_stride(3) > 0)
911 END IF
912
913 ! shortcut
914 l1 = pw%pw_grid%bounds(1, 1)
915 l2 = pw%pw_grid%bounds(1, 2)
916 l3 = pw%pw_grid%bounds(1, 3)
917 u1 = pw%pw_grid%bounds(2, 1)
918 u2 = pw%pw_grid%bounds(2, 2)
919 u3 = pw%pw_grid%bounds(2, 3)
920
921 ! Write the header: number of points and number of spins
922 ngrids = 1
923 IF (double) ngrids = 2
924 npoints = ((pw%pw_grid%npts(1) + my_stride(1) - 1)/my_stride(1))* &
925 ((pw%pw_grid%npts(2) + my_stride(2) - 1)/my_stride(1))* &
926 ((pw%pw_grid%npts(3) + my_stride(3) - 1)/my_stride(1))
927 IF (unit_nr > 1) WRITE (unit_nr, '(I7,I5)') npoints, ngrids
928
929 ALLOCATE (buf(l3:u3))
930 IF (double) ALLOCATE (buf2(l3:u3))
931
932 my_rank = pw%pw_grid%para%group%mepos
933 gid = pw%pw_grid%para%group
934 num_pe = pw%pw_grid%para%group%num_pe
935 tag = 1
936
937 rank(1) = unit_nr
938 rank(2) = my_rank
939 checksum = 0
940 IF (unit_nr > 0) checksum = 1
941
942 CALL gid%sum(checksum)
943 cpassert(checksum == 1)
944
945 CALL gid%maxloc(rank)
946 cpassert(rank(1) > 0)
947
948 dest = rank(2)
949 DO i1 = l1, u1, my_stride(1)
950 DO i2 = l2, u2, my_stride(2)
951
952 ! cycling through the CPUs, check if the current ray (I1,I2) is local to that CPU
953 IF (pw%pw_grid%para%mode /= pw_mode_local) THEN
954 DO ip = 0, num_pe - 1
955 IF (pw%pw_grid%para%bo(1, 1, ip, 1) <= i1 - l1 + 1 .AND. pw%pw_grid%para%bo(2, 1, ip, 1) >= i1 - l1 + 1 .AND. &
956 pw%pw_grid%para%bo(1, 2, ip, 1) <= i2 - l2 + 1 .AND. pw%pw_grid%para%bo(2, 2, ip, 1) >= i2 - l2 + 1) THEN
957 source = ip
958 END IF
959 END DO
960 ELSE
961 source = dest
962 END IF
963
964 IF (source == dest) THEN
965 IF (my_rank == source) THEN
966 buf(:) = pw%array(i1, i2, :)
967 IF (double) buf2(:) = pw2%array(i1, i2, :)
968 END IF
969 ELSE
970 IF (my_rank == source) THEN
971 buf(:) = pw%array(i1, i2, :)
972 CALL gid%send(buf, dest, tag)
973 IF (double) THEN
974 buf2(:) = pw2%array(i1, i2, :)
975 CALL gid%send(buf2, dest, tag)
976 END IF
977 END IF
978 IF (my_rank == dest) THEN
979 CALL gid%recv(buf, source, tag)
980 IF (double) CALL gid%recv(buf2, source, tag)
981 END IF
982 END IF
983
984 IF (.NOT. double) THEN
985 DO i3 = l3, u3, my_stride(3)
986 x = pw%pw_grid%dh(1, 1)*i1 + &
987 pw%pw_grid%dh(2, 1)*i2 + &
988 pw%pw_grid%dh(3, 1)*i3
989
990 y = pw%pw_grid%dh(1, 2)*i1 + &
991 pw%pw_grid%dh(2, 2)*i2 + &
992 pw%pw_grid%dh(3, 2)*i3
993
994 z = pw%pw_grid%dh(1, 3)*i1 + &
995 pw%pw_grid%dh(2, 3)*i2 + &
996 pw%pw_grid%dh(3, 3)*i3
997
998 IF (unit_nr > 0) THEN
999 WRITE (unit_nr, '(6(1X,ES12.4E3), 6(1X,ES12.4E3), 6(1X,ES12.4E3), 6(1X,ES12.4E3))') x, y, z, buf(i3)
1000 END IF
1001 END DO
1002
1003 ELSE
1004
1005 DO i3 = l3, u3, my_stride(3)
1006 x = pw%pw_grid%dh(1, 1)*i1 + &
1007 pw%pw_grid%dh(2, 1)*i2 + &
1008 pw%pw_grid%dh(3, 1)*i3
1009
1010 y = pw%pw_grid%dh(1, 2)*i1 + &
1011 pw%pw_grid%dh(2, 2)*i2 + &
1012 pw%pw_grid%dh(3, 2)*i3
1013
1014 z = pw%pw_grid%dh(1, 3)*i1 + &
1015 pw%pw_grid%dh(2, 3)*i2 + &
1016 pw%pw_grid%dh(3, 3)*i3
1017
1018 IF (unit_nr > 0) THEN
1019 WRITE (unit_nr, '(6(1X,ES12.4E3), 6(1X,ES12.4E3), 6(1X,ES12.4E3), 6(1X,ES12.4E3))') x, y, z, buf(i3), buf2(i3)
1020 END IF
1021 END DO
1022
1023 END IF ! Double
1024
1025 ! this double loop generates so many messages that it can overload
1026 ! the message passing system, e.g. on XT3
1027 ! we therefore put a barrier here that limits the amount of message
1028 ! that flies around at any given time.
1029 ! if ever this routine becomes a bottleneck, we should go for a
1030 ! more complicated rewrite
1031 CALL gid%sync()
1032
1033 END DO
1034 END DO
1035
1036 DEALLOCATE (buf)
1037 IF (double) DEALLOCATE (buf2)
1038
1039 CALL timestop(handle)
1040
1041 END SUBROUTINE pw_to_simple_volumetric
1042
1043END MODULE realspace_grid_cube
modulo
static GRID_HOST_DEVICE int modulo(int a, int m)
Equivalent of Fortran's MODULO, which always return a positive number. https://gcc....
Definition grid_common.h:125
cp_files
Utility routines to open and close files. Tracking of preconnections.
Definition cp_files.F:16
cp_files::open_file
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.
Definition cp_files.F:311
cp_files::close_file
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.
Definition cp_files.F:122
cp_log_handling
various routines to log and control the output. The idea is that decisions about where to log should ...
Definition cp_log_handling.F:41
cp_log_handling::cp_logger_get_default_io_unit
integer function, public cp_logger_get_default_io_unit(logger)
returns the unit nr for the ionode (-1 on all other processors) skips as well checks if the procs cal...
Definition cp_log_handling.F:523
kinds
Defines the basic variable types.
Definition kinds.F:23
kinds::dp
integer, parameter, public dp
Definition kinds.F:34
message_passing
Interface to the message passing library MPI.
Definition message_passing.F:23
message_passing::mp_file_type_hindexed_make_chv
type(mp_file_descriptor_type) function, public mp_file_type_hindexed_make_chv(count, lengths, displs)
Creates an indexed MPI type for arrays of strings using bytes for spacing (hindexed type)
Definition message_passing.F:4314
message_passing::mp_file_type_free
subroutine, public mp_file_type_free(type_descriptor)
Releases the type used for MPI I/O.
Definition message_passing.F:4503
message_passing::mpi_character_size
integer, parameter, public mpi_character_size
Definition message_passing.F:136
message_passing::file_offset
integer, parameter, public file_offset
Definition message_passing.F:124
message_passing::file_amode_rdonly
integer, parameter, public file_amode_rdonly
Definition message_passing.F:127
message_passing::mp_file_type_set_view_chv
subroutine, public mp_file_type_set_view_chv(fh, offset, type_descriptor)
Uses a previously created indexed MPI character type to tell the MPI processes how to partition (set_...
Definition message_passing.F:4357
pw_grid_types
Definition pw_grid_types.F:13
pw_grid_types::pw_mode_local
integer, parameter, public pw_mode_local
Definition pw_grid_types.F:27
pw_types
Definition pw_types.F:24
realspace_grid_cube
Generate Gaussian cube files.
Definition realspace_grid_cube.F:11
realspace_grid_cube::cube_to_pw
subroutine, public cube_to_pw(grid, filename, scaling, parallel_read, silent)
Computes the external density on the grid hacked from external_read_density.
Definition realspace_grid_cube.F:298
realspace_grid_cube::cube_values_format
character(len= *), parameter, public cube_values_format
Definition realspace_grid_cube.F:35
realspace_grid_cube::pw_to_simple_volumetric
subroutine, public pw_to_simple_volumetric(pw, unit_nr, stride, pw2)
Prints a simple grid file: X Y Z value.
Definition realspace_grid_cube.F:873
realspace_grid_cube::cube_value_format
character(len= *), parameter, public cube_value_format
Definition realspace_grid_cube.F:35
realspace_grid_cube::pw_to_cube
subroutine, public pw_to_cube(pw, unit_nr, title, particles_r, particles_z, particles_zeff, stride, max_file_size_mb, zero_tails, silent, mpi_io)
...
Definition realspace_grid_cube.F:88
realspace_grid_cube::cube_read_values
subroutine, public cube_read_values(values, buffer)
Read cube values from a character buffer.
Definition realspace_grid_cube.F:47
writebuffer
void writebuffer(int *psockfd, char *data, int *plen)
Writes to a socket.
Definition sockets.c:203
readbuffer
void readbuffer(int *psockfd, char *data, int *plen)
Reads from a socket.
Definition sockets.c:221
message_passing::mp_comm_type
Definition message_passing.F:161
message_passing::mp_file_descriptor_type
Definition message_passing.F:954
message_passing::mp_file_type
Definition message_passing.F:656
pw_types::pw_r3d_rs_type
Definition pw_types.F:62