Branch data Line data Source code
1 : : !!****m* ABINIT/m_wffile
2 : : !! NAME
3 : : !! m_wffile
4 : : !!
5 : : !! FUNCTION
6 : : !! This module provides the definition of the wffile_type used to WF file data.
7 : : !! As the type contains MPI-dependent fields, it has to be declared in a MPI-managed directory.
8 : : !!
9 : : !! COPYRIGHT
10 : : !! Copyright (C) 2009-2026 ABINIT group (MT,MB,MVer,ZL,MD)
11 : : !! This file is distributed under the terms of the
12 : : !! GNU General Public License, see ~abinit/COPYING
13 : : !! or http://www.gnu.org/copyleft/gpl.txt .
14 : : !! For the initials of contributors, see ~abinit/doc/developers/contributors.txt.
15 : : !!
16 : : !! NOTES
17 : : !! wffile_type: a handler for dealing with the IO of a wavefunction file
18 : : !!
19 : : !! SOURCE
20 : :
21 : : #if defined HAVE_CONFIG_H
22 : : #include "config.h"
23 : : #endif
24 : :
25 : : #include "abi_common.h"
26 : :
27 : : MODULE m_wffile
28 : :
29 : : use defs_basis
30 : : use m_errors
31 : : use m_abicore
32 : : USE_MPI
33 : : use m_xmpi
34 : : use m_nctk
35 : : use netcdf
36 : :
37 : : use defs_abitypes, only : MPI_Type
38 : : use m_io_tools, only : mvrecord, open_file
39 : : use m_fstrings, only : toupper, endswith, sjoin
40 : : use m_clib, only : clib_is_writable
41 : : use iso_c_binding
42 : :
43 : : implicit none
44 : :
45 : : private
46 : :
47 : : #ifdef HAVE_MPI1
48 : : include 'mpif.h'
49 : : #endif
50 : :
51 : : #define DEV_DEBUG_THIS 0
52 : :
53 : : !public procedures.
54 : : public :: WffOpen
55 : : public :: wffclose
56 : : public :: wffdelete
57 : : public :: wffkg
58 : : public :: wffoffset
59 : : public :: wffreaddatarec ! Generic subroutines to read data in one record of a wavefunction file
60 : : public :: wffreadnpwrec
61 : : public :: wffreadskiprec
62 : : public :: wffreadwrite_mpio
63 : : public :: wffwritedatarec ! Generic subroutines to write data in one record of a wavefunction file
64 : : public :: wffwritenpwrec
65 : : public :: xderiveread ! Generic subroutines to read wf files.
66 : : public :: xmpi_read_int2d
67 : : public :: xderivewrite
68 : :
69 : : public :: getRecordMarkerLength_wffile
70 : : public :: xnullifyOff
71 : : public :: xmoveOff
72 : : public :: xderiveWRecEnd
73 : : public :: xderiveWRecInit
74 : : public :: xderiveRRecEnd
75 : : public :: xderiveRRecInit
76 : : #if defined HAVE_MPI_IO
77 : : public :: rwRecordMarker
78 : : #endif
79 : : public :: clsopn
80 : : public :: wff_usef90
81 : : public :: xdefineOff
82 : : !!***
83 : :
84 : : !Generic interface of the routines wffreaddatarec
85 : : interface wffreaddatarec
86 : : module procedure WffReadDataRec_dp1d
87 : : module procedure WffReadDataRec_dp2d
88 : : end interface wffreaddatarec
89 : :
90 : : !Generic interface of the routines wffwritedatarec
91 : : interface wffwritedatarec
92 : : module procedure WffWriteDataRec_int2d
93 : : module procedure WffWriteDataRec_dp1d
94 : : module procedure WffWriteDataRec_dp2d
95 : : end interface
96 : :
97 : : !Generic interface of the routines xderiveread
98 : : interface xderiveread
99 : : module procedure xderiveRead_int ! read integer value
100 : : module procedure xderiveRead_int1d ! read integer array 1d
101 : : module procedure xderiveRead_int2d ! read integer array 2d
102 : : module procedure xderiveRead_dp ! read double precision value
103 : : module procedure xderiveRead_dp1d ! read double precision array 1d
104 : : module procedure xderiveRead_dp2d ! read double precision array 2d
105 : : module procedure xderiveRead_int2d_displ ! read integer array 2d non-contiguous
106 : : module procedure xderiveRead_dp2d_displ ! read double precision array 2d non-contiguous
107 : : module procedure xderiveReadVal_char ! read character string
108 : : module procedure xmpi_read_int2d
109 : : end interface xderiveread
110 : :
111 : : !Generic interface of the routines xderivewrite
112 : : interface xderivewrite
113 : : module procedure xderiveWrite_int ! write integer value
114 : : module procedure xderiveWrite_int1d ! write integer array 1d
115 : : module procedure xderiveWrite_int2d ! write integer array 2d
116 : : module procedure xderiveWrite_dp ! write double precision value
117 : : module procedure xderiveWrite_dp1d ! write double precision array 1d
118 : : module procedure xderiveWrite_dp2d ! write double precision array 2d
119 : : module procedure xderiveWrite_dp2d_seq ! write double precision array 2d in sequential
120 : : module procedure xderiveWrite_int2d_displ ! write integer array 2d non contiguous
121 : : module procedure xderiveWrite_dp2d_displ ! write double precision array 2d non contiguous
122 : : module procedure xderiveWrite_char ! write character string
123 : : end interface xderivewrite
124 : :
125 : : !!****t* m_wffile/wffile_type
126 : : !! NAME
127 : : !! wffile_type
128 : : !!
129 : : !! FUNCTION
130 : : !! This structure datatype is a handler for dealing with the IO of a
131 : : !! wavefunction file.
132 : : !! It contains, among other things, the method of access to the file
133 : : !! (standard F90 read/write, or NetCDF call, or MPI IO), the unit number
134 : : !! if applicable, the filename, the information on the
135 : : !! parallelism, etc ...
136 : : !!
137 : : !! SOURCE
138 : :
139 : : type, public :: wffile_type
140 : :
141 : : ! WARNING : if you modify this datatype, please check there there is no creation/destruction/copy routine,
142 : : ! declared in another part of ABINIT, that might need to take into account your modification.
143 : :
144 : : ! Integer scalar
145 : : integer :: unwff
146 : : ! unwff unit number of unformatted wavefunction disk file
147 : :
148 : : integer :: iomode
149 : : ! Method to access the wavefunction file
150 : : ! IO_MODE_FORTRAN for usual Fortran IO routines
151 : : ! IO_MODE_FORTRAN_MASTER if usual Fortran IO routines, but only the master node in the parallel case
152 : : ! IO_MODE_MPI if MPI/IO routines (this access method is only available in parallel)
153 : : ! IO_MODE_NETCDF if NetCDF routines (obsolete, do not use)
154 : : ! IO_MODE_ETSF, NetCDF format read via etsf-io.
155 : :
156 : : integer :: formwff
157 : : ! formwff=format of the eigenvalues
158 : : ! -1 => not used
159 : : ! 0 => vector of eigenvalues
160 : : ! 1 => hermitian matrix of eigenvalues
161 : :
162 : : integer :: headform
163 : : ! headform=format of the header
164 : :
165 : : integer :: kgwff
166 : : ! kgwff if 1 , read or write kg_k ; if 0, do not care about kg_k
167 : :
168 : : ! Character
169 : : character(len=fnlen) :: fname
170 : : ! filename (if available)
171 : :
172 : : ! In case of MPI parallel use
173 : : integer :: master
174 : : ! index of the processor master of the IO procedure when the WffOpen call is issued
175 : :
176 : : integer :: me
177 : : ! index of my processor in the spaceComm communicator
178 : :
179 : : integer :: me_mpiio
180 : : ! index of my processor in the spaceComm_mpiio communicator
181 : :
182 : : integer :: nproc
183 : : ! number of processors that will have access to the file
184 : :
185 : : integer :: spaceComm
186 : : ! space communicator for the standard FORTRAN access to the file
187 : :
188 : : integer :: spaceComm_mpiio
189 : : ! space communicator for the MPI/IO access to the file
190 : :
191 : : ! In case of MPI/IO : additional information
192 : : integer :: fhwff
193 : : ! file handle used to access the file with MPI/IO.
194 : :
195 : : integer(kind=XMPI_OFFSET_KIND) :: nbOct_int,nbOct_dp,nbOct_ch
196 : : ! nbOct_int byte number of int value
197 : : ! nbOct_dp byte number of dp value
198 : : ! nbOct_ch byte number of character value
199 : :
200 : : integer(kind=XMPI_OFFSET_KIND) :: nbOct_recMarker
201 : : ! byte number of Fortran file record markers
202 : :
203 : : integer(kind=XMPI_OFFSET_KIND) :: lght_recs
204 : : ! length of record
205 : :
206 : : integer :: marker_mpi_type
207 : : ! MPI Datatype for Fortran record markers
208 : :
209 : : integer(kind=XMPI_OFFSET_KIND) :: offwff,off_recs
210 : : ! offwff offset position of unformatted wavefunction disk file
211 : : ! off_recs offset position of start record
212 : : ! (used in parallel MPI-IO)
213 : :
214 : : integer :: offset_mpi_type
215 : : ! MPI Datatype for INTEGER(kind=MPI_OFFSET_KIND)
216 : :
217 : : end type wffile_type
218 : :
219 : :
220 : : CONTAINS
221 : : !!***
222 : :
223 : : !----------------------------------------------------------------------
224 : :
225 : : !!****f* m_wffile/getRecordMarkerLength_wffile
226 : : !! NAME
227 : : !! getRecordMarkerLength_wffile
228 : : !!
229 : : !! FUNCTION
230 : : !! Get the record marker length of the FORTRAN header of a file to access it in MPI/IO.
231 : : !! This routine assumes that the header has been written (and flushed) in the file.
232 : : !!
233 : : !! SIDE EFFECTS
234 : : !! wff=<type(wffile_type)>=structured info for reading/writing the wavefunctions
235 : : !! only%nbOct_recMarker is changed
236 : : !!
237 : : !! SOURCE
238 : :
239 : 0 : subroutine getRecordMarkerLength_wffile(wff)
240 : :
241 : : !Arguments ------------------------------------
242 : : !scalars
243 : : type(wffile_type),intent(inout) :: wff
244 : :
245 : : !Local variables-------------------------------
246 : : #if defined HAVE_MPI_IO
247 : : !scalars
248 : : integer :: ierr,ii,iimax
249 : : integer(kind=MPI_OFFSET_KIND) :: posit,rml
250 : : character(len=500) :: msg
251 : : !arrays
252 : : integer :: headform(1),statux(MPI_STATUS_SIZE)
253 : : integer(kind=MPI_OFFSET_KIND) :: off(1)
254 : : #endif
255 : :
256 : : !************************************************************************
257 : :
258 : : #ifdef DEV_DEBUG_THIS
259 : : return
260 : : ! Already done in WffOpen
261 : : #endif
262 : :
263 : : #if defined HAVE_MPI_IO
264 : :
265 : : if (wff%nbOct_recMarker>0) return
266 : :
267 : : !wff%nbOct_recMarker=4;return
268 : : !call flush(wff%unwff)
269 : : !call MPI_FILE_SYNC(wff%fhwff,ierr)
270 : :
271 : : !Only master do that
272 : : ierr=0
273 : : if (wff%master==wff%me) then
274 : :
275 : : ! Define number of INTEGER types to be tested
276 : : #if defined HAVE_FC_INT_QUAD
277 : : iimax=4
278 : : #else
279 : : iimax=3
280 : : #endif
281 : :
282 : : ! Try to read headform
283 : : rml=-1;ii=0
284 : : do while (wff%nbOct_recMarker<=0.and.ii<iimax)
285 : : ii=ii+1
286 : : if (ii==1) rml=4
287 : : if (ii==2) rml=8
288 : : if (ii==3) rml=2
289 : : if (ii==4) rml=16
290 : : posit=rml+6*wff%nbOct_ch
291 : : call MPI_FILE_READ_AT(wff%fhwff,posit,headform,1,MPI_INTEGER,statux,ierr)
292 : : if (ierr==MPI_SUCCESS) then
293 : : if (headform(1)==wff%headform) wff%nbOct_recMarker=rml
294 : : end if
295 : : end do
296 : :
297 : : if (ierr/=MPI_SUCCESS) then
298 : : ABI_BUG("Header problem")
299 : : end if
300 : :
301 : : if (ii==iimax.and.wff%nbOct_recMarker<=0) then
302 : : ! if (iimax>=4) then
303 : : ! write(msg,'(3a)') &
304 : : ! & ' Your architecture is not able to handle 16, 8, 4 or 2-bytes FORTRAN file record markers !',ch10,&
305 : : ! & ' You cannot use ABINIT and MPI/IO.'
306 : : ! else
307 : : ! write(msg,'(3a)') &
308 : : ! & ' Your architecture is not able to handle 8, 4 or 2-bytes FORTRAN file record markers !',ch10,&
309 : : ! & ' You cannot use ABINIT and MPI/IO.'
310 : : ! end if
311 : : write(msg,'(13a)') &
312 : : & ' Error during FORTRAN file record marker detection:',ch10,&
313 : : & ' It was not possible to read/write a small file!',ch10,&
314 : : & ' ACTION: check your access permissions to the file system.',ch10,&
315 : : & ' Common sources of this problem:',ch10,&
316 : : & ' - Quota limit exceeded,',ch10,&
317 : : & ' - R/W incorrect permissions,',ch10,&
318 : : & ' - WFK file requested as input (irdwfk=1/getwfk=1) but not existing ...'
319 : : ABI_ERROR(msg)
320 : : else
321 : : write(msg,'(a,i0)') &
322 : : & ' MPI/IO accessing FORTRAN file header: detected record mark length=',wff%nbOct_recMarker
323 : : ABI_COMMENT(msg)
324 : : end if
325 : :
326 : : end if ! me=master
327 : :
328 : : !Broadcast record marker length
329 : : if (wff%spaceComm/=MPI_COMM_SELF) then
330 : : off(1)=wff%nbOct_recMarker
331 : : call MPI_BCAST(off,1,wff%offset_mpi_type,wff%master,wff%spaceComm,ierr)
332 : : wff%nbOct_recMarker=off(1)
333 : : end if
334 : :
335 : : !Select MPI datatype for markers
336 : : if (wff%nbOct_recMarker==4) then
337 : : wff%marker_mpi_type=MPI_INTEGER4
338 : : else if (wff%nbOct_recMarker==8) then
339 : : wff%marker_mpi_type=MPI_INTEGER8
340 : : #if defined HAVE_FC_INT_QUAD && defined HAVE_MPI_INTEGER16
341 : : else if (wff%nbOct_recMarker==16) then
342 : : wff%marker_mpi_type=MPI_INTEGER16
343 : : #endif
344 : : else if (wff%nbOct_recMarker==2) then
345 : : wff%marker_mpi_type=MPI_INTEGER2
346 : : end if
347 : :
348 : : #endif
349 : :
350 : : RETURN
351 : : ABI_UNUSED(wff%me)
352 : :
353 : : end subroutine getRecordMarkerLength_wffile
354 : : !!***
355 : :
356 : : !----------------------------------------------------------------------
357 : :
358 : : !!****f* m_wffile/rwRecordMarker
359 : : !! NAME
360 : : !! rwRecordMarker
361 : : !!
362 : : !! FUNCTION
363 : : !! Read/Write a record marker in a FORTRAN file at a given file pointer position.
364 : : !! This is needed to access data in a FORTRAN file with MPI/IO.
365 : : !!
366 : : !! INPUTS
367 : : !! option=1 for reading by current proc
368 : : !! 2 for writing by current proc
369 : : !! 3 for reading by all procs
370 : : !! 4 for writing by all procs
371 : : !! posit= position of the MPI/IO file pointer
372 : : !! wff=<type(wffile_type)>=structured info for reading/writing
373 : : !! Use here only:
374 : : !! wff%fhwff= handle of the MPI/IO file
375 : : !! wff%nbOct_recMarker= length of Fortran record markers
376 : : !!
377 : : !! OUTPUT
378 : : !! ierr= error code
379 : : !!
380 : : !! SIDE EFFECTS
381 : : !! posit= position of the MPI/IO file pointer
382 : : !! updated after the reading (with the length of the record)
383 : : !! recordmarker= content of the record marker
384 : : !!
385 : : !! SOURCE
386 : :
387 : : #if defined HAVE_MPI_IO
388 : :
389 : 370 : subroutine rwRecordMarker(option,posit,recordmarker,wff,ierr)
390 : :
391 : : !Arguments ------------------------------------
392 : : !scalars
393 : : integer,intent(in) :: option
394 : : integer(kind=MPI_OFFSET_KIND),intent(inout) :: posit,recordmarker
395 : : integer,intent(out) :: ierr
396 : : type(wffile_type),intent(inout) :: wff
397 : :
398 : : !Local variables-------------------------------
399 : : !scalars
400 : : integer(kind=2) :: delim_record2(1)
401 : : integer(kind=4) :: delim_record4(1)
402 : : integer(kind=8) :: delim_record8(1)
403 : : #if defined HAVE_FC_INT_QUAD
404 : : integer(kind=16) :: delim_record16(1)
405 : : #endif
406 : : !character(len=500) :: msg
407 : : !arrays
408 : : integer :: statux(MPI_STATUS_SIZE)
409 : :
410 : : !************************************************************************
411 : :
412 : 370 : ierr=0
413 : :
414 [ + + ]: 370 : if (option==1) then
415 [ + - ]: 235 : if (wff%nbOct_recMarker==4) then
416 : 235 : call MPI_FILE_READ_AT(wff%fhwff,posit,delim_record4,1,wff%marker_mpi_type,statux,ierr)
417 : 235 : recordmarker = delim_record4(1)
418 [ # # ]: 0 : else if (wff%nbOct_recMarker==8) then
419 : 0 : call MPI_FILE_READ_AT(wff%fhwff,posit,delim_record8,1,wff%marker_mpi_type,statux,ierr)
420 : 0 : recordmarker = delim_record8(1)
421 : : #if defined HAVE_FC_INT_QUAD
422 [ # # ]: 0 : else if (wff%nbOct_recMarker==16) then
423 : 0 : call MPI_FILE_READ_AT(wff%fhwff,posit,delim_record16,1,wff%marker_mpi_type,statux,ierr)
424 : 0 : recordmarker = delim_record16(1)
425 : : #endif
426 [ # # ]: 0 : else if (wff%nbOct_recMarker==2) then
427 : 0 : call MPI_FILE_READ_AT(wff%fhwff,posit,delim_record2,1,wff%marker_mpi_type,statux,ierr)
428 : 0 : recordmarker = delim_record2(1)
429 : : else
430 : 0 : ABI_BUG('Wrong record marker length!')
431 : : end if
432 : :
433 [ + - ]: 135 : else if (option==2) then
434 [ + - ]: 135 : if (wff%nbOct_recMarker==4) then
435 : 135 : delim_record4(1) = recordmarker
436 : 135 : call MPI_FILE_WRITE_AT(wff%fhwff,posit,delim_record4,1,wff%marker_mpi_type,statux,ierr)
437 [ # # ]: 0 : else if (wff%nbOct_recMarker==8) then
438 : 0 : delim_record8(1) = recordmarker
439 : 0 : call MPI_FILE_WRITE_AT(wff%fhwff,posit,delim_record8,1,wff%marker_mpi_type,statux,ierr)
440 : : #if defined HAVE_FC_INT_QUAD
441 [ # # ]: 0 : else if (wff%nbOct_recMarker==16) then
442 : 0 : delim_record16(1) = recordmarker
443 : 0 : call MPI_FILE_WRITE_AT(wff%fhwff,posit,delim_record16,1,wff%marker_mpi_type,statux,ierr)
444 : : #endif
445 [ # # ]: 0 : else if (wff%nbOct_recMarker==2) then
446 : 0 : delim_record2(1) = recordmarker
447 : 0 : call MPI_FILE_WRITE_AT(wff%fhwff,posit,delim_record2,1,wff%marker_mpi_type,statux,ierr)
448 : : else
449 : 0 : ABI_BUG('Wrong record marker length!')
450 : : end if
451 : :
452 [ # # ]: 0 : else if (option==3) then
453 [ # # ]: 0 : if (wff%nbOct_recMarker==4) then
454 : 0 : call MPI_FILE_READ_AT_ALL(wff%fhwff,posit,delim_record4,1,wff%marker_mpi_type,statux,ierr)
455 : 0 : recordmarker = delim_record4(1)
456 [ # # ]: 0 : else if (wff%nbOct_recMarker==8) then
457 : 0 : call MPI_FILE_READ_AT_ALL(wff%fhwff,posit,delim_record8,1,wff%marker_mpi_type,statux,ierr)
458 : 0 : recordmarker = delim_record8(1)
459 : : #if defined HAVE_FC_INT_QUAD
460 [ # # ]: 0 : else if (wff%nbOct_recMarker==16) then
461 : 0 : call MPI_FILE_READ_AT_ALL(wff%fhwff,posit,delim_record16,1,wff%marker_mpi_type,statux,ierr)
462 : 0 : recordmarker = delim_record16(1)
463 : : #endif
464 [ # # ]: 0 : else if (wff%nbOct_recMarker==2) then
465 : 0 : call MPI_FILE_READ_AT_ALL(wff%fhwff,posit,delim_record2,1,wff%marker_mpi_type,statux,ierr)
466 : 0 : recordmarker = delim_record2(1)
467 : : else
468 : 0 : ABI_BUG('Wrong record marker length !')
469 : : end if
470 : :
471 [ # # ]: 0 : else if (option==4) then
472 [ # # ]: 0 : if (wff%nbOct_recMarker==4) then
473 : 0 : delim_record4(1) = recordmarker
474 : 0 : call MPI_FILE_WRITE_AT_ALL(wff%fhwff,posit,delim_record4,1,wff%marker_mpi_type,statux,ierr)
475 [ # # ]: 0 : else if (wff%nbOct_recMarker==8) then
476 : 0 : delim_record8(1) = recordmarker
477 : 0 : call MPI_FILE_WRITE_AT_ALL(wff%fhwff,posit,delim_record8,1,wff%marker_mpi_type,statux,ierr)
478 : : #if defined HAVE_FC_INT_QUAD
479 [ # # ]: 0 : else if (wff%nbOct_recMarker==16) then
480 : 0 : delim_record16(1) = recordmarker
481 : 0 : call MPI_FILE_WRITE_AT_ALL(wff%fhwff,posit,delim_record16,1,wff%marker_mpi_type,statux,ierr)
482 : : #endif
483 [ # # ]: 0 : else if (wff%nbOct_recMarker==2) then
484 : 0 : delim_record2(1) = recordmarker
485 : 0 : call MPI_FILE_WRITE_AT_ALL(wff%fhwff,posit,delim_record2,1,wff%marker_mpi_type,statux,ierr)
486 : : else
487 : 0 : ABI_BUG('Wrong record marker length!')
488 : : end if
489 : :
490 : : else
491 : 0 : ABI_BUG('Wrong value for option!')
492 : : end if
493 : :
494 : 370 : posit = posit + recordmarker + 2*wff%nbOct_recMarker
495 : :
496 : 370 : end subroutine rwRecordMarker
497 : : #endif
498 : : !!***
499 : :
500 : : !------------------------------------------------------------------------------------
501 : :
502 : : !!****f* m_wffile/xnullifyOff
503 : : !! NAME
504 : : !! xnullifyOff
505 : : !!
506 : : !! FUNCTION
507 : : !! In case of MPI I/O, nullify the offset of a WF file
508 : : !!
509 : : !! INPUTS
510 : : !!
511 : : !! OUTPUT
512 : : !!
513 : : !! SIDE EFFECTS
514 : : !! wff=<type(wffile_type)>=structured info for reading/writing
515 : : !!
516 : : !! SOURCE
517 : :
518 : 0 : subroutine xnullifyOff(wff)
519 : :
520 : : !Arguments ------------------------------------
521 : : type(wffile_type),intent(inout) :: wff
522 : :
523 : : ! *************************************************************************
524 : :
525 : : #if defined HAVE_MPI_IO
526 : 0 : wff%offwff = 0
527 : 0 : wff%off_recs = 0
528 : 0 : wff%lght_recs = 0
529 : : #endif
530 : :
531 : : RETURN
532 : : ABI_UNUSED(wff%me)
533 : :
534 : : end subroutine xnullifyOff
535 : : !!***
536 : :
537 : : !------------------------------------------------------------------------------------
538 : :
539 : : !!****f* m_wffile/xmoveOff
540 : : !! NAME
541 : : !! xmoveOff
542 : : !!
543 : : !! FUNCTION
544 : : !! In case of MPI I/O, move the offset of a WF file
545 : : !!
546 : : !! INPUTS
547 : : !! [n_int] = number if integers to skip
548 : : !! [n_dp] = number if double precision reals to skip
549 : : !! [n_ch] = number if characters to skip
550 : : !! [n_mark]= number if record markers to skip
551 : : !!
552 : : !! OUTPUT
553 : : !!
554 : : !! SIDE EFFECTS
555 : : !! wff=<type(wffile_type)>=structured info for reading/writing
556 : : !!
557 : : !! SOURCE
558 : :
559 : 0 : subroutine xmoveOff(wff,n_int,n_dp,n_ch,n_mark)
560 : :
561 : : !Arguments ------------------------------------
562 : : integer,intent(in),optional :: n_int,n_dp,n_ch,n_mark
563 : : type(wffile_type),intent(inout) :: wff
564 : :
565 : : ! *************************************************************************
566 : :
567 : : #if defined HAVE_MPI_IO
568 [ # # ]: 0 : if (present(n_int) ) wff%offwff=wff%offwff+n_int *wff%nbOct_int
569 [ # # ]: 0 : if (present(n_dp) ) wff%offwff=wff%offwff+n_dp *wff%nbOct_dp
570 [ # # ]: 0 : if (present(n_ch) ) wff%offwff=wff%offwff+n_ch *wff%nbOct_ch
571 [ # # ]: 0 : if (present(n_mark)) wff%offwff=wff%offwff+n_mark*wff%nbOct_recMarker
572 : : #else
573 : : !This section should not be used...
574 : : if (present(n_int) .and.(.false.)) write(std_out,*) n_int
575 : : if (present(n_dp) .and.(.false.)) write(std_out,*) n_dp
576 : : if (present(n_ch) .and.(.false.)) write(std_out,*) n_ch
577 : : if (present(n_mark).and.(.false.)) write(std_out,*) n_mark
578 : : #endif
579 : :
580 : 0 : end subroutine xmoveOff
581 : : !!***
582 : :
583 : : !------------------------------------------------------------------------------------
584 : :
585 : : !!****f* m_wffile/xderiveWRecEnd
586 : : !! NAME
587 : : !! xderiveWRecEnd
588 : : !!
589 : : !! FUNCTION
590 : : !! Writes the first and last wavefunction block marker using MPI/IO
591 : : !!
592 : : !! INPUTS
593 : : !! me_proc= (optional argument) index of current proc
594 : : !!
595 : : !! OUTPUT
596 : : !! ierr= exit status, a non-zero value meaning there is an error
597 : : !!
598 : : !! SIDE EFFECTS
599 : : !! wff= structured info for reading/writing the wavefunctions
600 : : !!
601 : : !! NOTES
602 : : !! We assume that:
603 : : !! wff%offwff contains the position of the end of the record
604 : : !! wff%off_recs contains the position of the beginning of the record
605 : : !!
606 : : !! SOURCE
607 : :
608 : 82 : subroutine xderiveWRecEnd(wff,ierr,me_proc)
609 : :
610 : : !Arguments ------------------------------------
611 : : type(wffile_type),intent(inout) :: wff
612 : : integer,intent(in),optional :: me_proc
613 : : integer,intent(out) :: ierr
614 : :
615 : : !Local variables-------------------------------
616 : : #if defined HAVE_MPI_IO
617 : : !scalars
618 : : integer :: me
619 : : integer(kind=MPI_OFFSET_KIND) :: delim_record,posit
620 : : !arrays
621 : : #endif
622 : :
623 : : ! *************************************************************************
624 : :
625 : 82 : ierr=0
626 : :
627 : : #if defined HAVE_MPI_IO
628 [ + + ]: 82 : me=-1;if (present(me_proc)) me=me_proc
629 [ + + ]: 52 : if (me==-1.or.me==0) then
630 : :
631 : 45 : delim_record=wff%offwff-wff%off_recs-wff%nbOct_recMarker
632 : :
633 : : ! Write the first word of the record
634 : 45 : posit=wff%off_recs
635 : 45 : call rwRecordMarker(2,posit,delim_record,wff,ierr)
636 : :
637 : : ! Write the last word of the record
638 : 45 : posit=wff%offwff
639 : 45 : call rwRecordMarker(2,posit,delim_record,wff,ierr)
640 : :
641 : : end if
642 : :
643 : 82 : wff%offwff = wff%offwff + wff%nbOct_recMarker
644 : : #endif
645 : :
646 : 82 : RETURN
647 : : ABI_UNUSED((/wff%me,me_proc/))
648 : :
649 : : end subroutine xderiveWRecEnd
650 : : !!***
651 : :
652 : : !------------------------------------------------------------------------------
653 : :
654 : : !!****f* m_wffile/xderiveWRecInit
655 : : !! NAME
656 : : !! xderiveWRecInit
657 : : !!
658 : : !! FUNCTION
659 : : !! Writes the first wavefunction block marker using MPI/IO.
660 : : !!
661 : : !! INPUTS
662 : : !! me_proc= (optional argument) index of current proc
663 : : !!
664 : : !! OUTPUT
665 : : !! ierr= exit status, a non-zero value meaning there is an error
666 : : !!
667 : : !! SIDE EFFECTS
668 : : !! wff= structured info for reading/writing the wavefunctions
669 : : !!
670 : : !! NOTES
671 : : !! We assume that:
672 : : !! wff%offwff contains the position of the beginning of the record
673 : : !!
674 : : !! SOURCE
675 : :
676 : 82 : subroutine xderiveWRecInit(wff,ierr,me_proc)
677 : :
678 : : !Arguments ------------------------------------
679 : : type(wffile_type),intent(inout) :: wff
680 : : integer,intent(in),optional :: me_proc
681 : : integer,intent(out) :: ierr
682 : :
683 : : !Local variables-------------------------------
684 : : #if defined HAVE_MPI_IO
685 : : !scalars
686 : : integer :: me
687 : : integer(kind=MPI_OFFSET_KIND) :: delim_record,posit
688 : : !arrays
689 : : #endif
690 : :
691 : : ! *************************************************************************
692 : :
693 : 82 : ierr=0
694 : :
695 : : #if defined HAVE_MPI_IO
696 [ + + ]: 82 : me=-1;if (present(me_proc)) me=me_proc
697 [ + + ]: 52 : if (me==-1.or.me==0) then
698 : :
699 : : ! Write the first word of the record
700 : 45 : posit=wff%offwff;delim_record=0
701 : 45 : call rwRecordMarker(2,posit,delim_record,wff,ierr)
702 : :
703 : : end if
704 : :
705 : 82 : wff%off_recs = wff%offwff
706 : 82 : wff%offwff = wff%offwff + wff%nbOct_recMarker
707 : : #endif
708 : :
709 : 82 : RETURN
710 : : ABI_UNUSED((/wff%me,me_proc/))
711 : :
712 : : end subroutine xderiveWRecInit
713 : : !!***
714 : :
715 : : !---------------------------------------------------------------------------------
716 : :
717 : : !!****f* m_wffile/xderiveRRecEnd
718 : : !! NAME
719 : : !! xderiveRRecEnd
720 : : !!
721 : : !! FUNCTION
722 : : !! Initializes the end-of-record offset for MPI/IO.
723 : : !!
724 : : !! INPUTS
725 : : !! me_proc= (optional argument) index of current proc
726 : : !!
727 : : !! OUTPUT
728 : : !! ierr= exit status, a non-zero value meaning there is an error
729 : : !!
730 : : !! SIDE EFFECTS
731 : : !! wff= structured info for reading/writing the wavefunctions
732 : : !!
733 : : !! NOTES
734 : : !! We assume that:
735 : : !! wff%off_recs contains the position of the beginning of the record
736 : : !!
737 : : !! SOURCE
738 : :
739 : 32 : subroutine xderiveRRecEnd(wff,ierr)
740 : :
741 : : !Arguments ------------------------------------
742 : : integer,intent(out) :: ierr
743 : : type(wffile_type),intent(inout) :: wff
744 : :
745 : : ! *************************************************************************
746 : :
747 : 32 : ierr=0
748 : : #if defined HAVE_MPI_IO
749 : : !Define offset end of record
750 : 32 : wff%offwff = wff%off_recs + wff%lght_recs + 2*wff%nbOct_recMarker
751 : : #endif
752 : :
753 : : RETURN
754 : : ABI_UNUSED(wff%me)
755 : :
756 : : end subroutine xderiveRRecEnd
757 : : !!***
758 : :
759 : : !-------------------------------------------------------------------------------
760 : :
761 : : !!****f* m_wffile/xderiveRRecInit
762 : : !! NAME
763 : : !! xderiveRRecInit
764 : : !!
765 : : !! FUNCTION
766 : : !! Initializes the record length for MPI/IO.
767 : : !!
768 : : !! INPUTS
769 : : !! me_proc= (optional argument) index of current proc
770 : : !!
771 : : !! OUTPUT
772 : : !! ierr= exit status, a non-zero value meaning there is an error
773 : : !!
774 : : !! SIDE EFFECTS
775 : : !! wff= structured info for reading/writing the wavefunctions
776 : : !!
777 : : !! NOTES
778 : : !! We assume that:
779 : : !! wff%offwff contains the position of the beginning of the record
780 : : !!
781 : : !! SOURCE
782 : :
783 : 32 : subroutine xderiveRRecInit(wff,ierr)
784 : :
785 : : !Arguments ------------------------------------
786 : : type(wffile_type),intent(inout) :: wff
787 : : integer,intent(out) :: ierr
788 : :
789 : : !Local variables-------------------------------
790 : : #if defined HAVE_MPI_IO
791 : : integer(kind=MPI_OFFSET_KIND) :: delim_record,posit
792 : : #endif
793 : :
794 : : ! *************************************************************************
795 : :
796 : : ierr=0
797 : :
798 : : #if defined HAVE_MPI_IO
799 : 32 : wff%off_recs = wff%offwff
800 : :
801 : : !Read the length of the record
802 : 32 : posit=wff%off_recs
803 : 32 : call rwRecordMarker(1,posit,delim_record,wff,ierr)
804 : :
805 : 32 : wff%lght_recs = delim_record
806 : 32 : wff%offwff = wff%offwff + wff%nbOct_recMarker
807 : : #endif
808 : :
809 : 32 : RETURN
810 : : ABI_UNUSED(wff%me)
811 : :
812 : : end subroutine xderiveRRecInit
813 : : !!***
814 : :
815 : : !----------------------------------------------------------------------
816 : :
817 : : !!****f* m_wffile/clsopn
818 : : !! NAME
819 : : !! clsopn
820 : : !!
821 : : !! FUNCTION
822 : : !! Close wavefunction file (provided its access is standard F90 IO), then reopen the same.
823 : : !! Uses fortran inquire statement to reopen with same characteristics.
824 : : !!
825 : : !! INPUTS
826 : : !! wff=number of unit to which on which file is already opened.
827 : : !!
828 : : !! SIDE EFFECTS
829 : : !!
830 : : !! SOURCE
831 : :
832 : 0 : subroutine clsopn(wff)
833 : :
834 : : !Arguments ------------------------------------
835 : : !scalars
836 : : type(wffile_type),intent(inout) :: wff
837 : :
838 : : !Local variables-------------------------------
839 : : !scalars
840 : : integer :: ios,unit
841 : : logical :: nmd,od
842 : : character(len=11) :: fm
843 : : character(len=500) :: message
844 : : character(len=fnlen) :: filnam
845 : :
846 : : ! *************************************************************************
847 : :
848 [ # # # # : 0 : if ( ANY(wff%iomode==(/IO_MODE_FORTRAN_MASTER,IO_MODE_FORTRAN/) ))then
# # ]
849 : :
850 : 0 : unit=wff%unwff
851 : 0 : inquire (unit=unit,iostat=ios,opened=od,name=filnam,form=fm,named=nmd)
852 : :
853 : : ! ios is a status specifier. If an error condition exists,
854 : : ! ios is assigned a processor-dependent value > 0.
855 [ # # ]: 0 : if (ios/=0) then
856 : : write(message, '(/,a,/,a,i8,a,i8,/,a,/,a,/,a)' ) &
857 : 0 : & ' clsopn : ERROR -',&
858 : 0 : & ' Attempt to inquire about unit=',unit,&
859 : 0 : & ' indicates error condition iostat=',ios,&
860 : 0 : & ' May be due to temporary problem with file, disks or network.',&
861 : 0 : & ' Action: check whether there might be some external problem,',&
862 : 0 : & ' then resubmit.'
863 : 0 : ABI_ERROR(message)
864 : :
865 : : ! od is a logical variable which is set to true if the specified
866 : : ! unit is connected to a file; otherwise it is set to false.
867 [ # # ]: 0 : else if (.not.od) then
868 : : write(message, '(/,a,/,a,i8,/,a,/,a,/,a,/,a)' ) &
869 : 0 : & ' clsopn : ERROR -',&
870 : 0 : & ' Tried to inquire about unit',unit,&
871 : 0 : & ' and found it not connected to a file.',&
872 : 0 : & ' May be due to temporary problem with file, disks or network.',&
873 : 0 : & ' Action: check whether there might be some external problem,',&
874 : 0 : & ' then resubmit.'
875 : 0 : ABI_ERROR(message)
876 : :
877 : : ! nmd is a logical variable assigned the value true if the file
878 : : ! has a name; otherwise false. A scratch file is not named.
879 [ # # ]: 0 : else if (.not.nmd) then
880 : :
881 : : ! No action for the time being. Possibility to debug.
882 : :
883 : : else
884 : :
885 : : ! May now close the file and then reopen it
886 : : ! (file is already opened according to above checks)
887 : 0 : close (unit=unit)
888 : 0 : open (unit=unit,file=filnam,form=fm,status='old') !VALGRIND complains filnam is just a few thousand bytes inside a block of 8300
889 : :
890 : : end if
891 : :
892 [ # # ]: 0 : else if (wff%iomode == IO_MODE_MPI) then
893 : 0 : call xnullifyOff(wff)
894 : : else if (wff%iomode == IO_MODE_ETSF) then
895 : : ! We do nothing, ETSF access already not being sequential.
896 : : end if
897 : :
898 : 0 : end subroutine clsopn
899 : : !!***
900 : :
901 : : !----------------------------------------------------------------------
902 : :
903 : : !!****f* m_wffile/wff_usef90
904 : : !! NAME
905 : : !! wff_usef90
906 : : !!
907 : : !! FUNCTION
908 : : !! 1 if a Fortran file is going to be read by this node, 0 otherwise.
909 : : !!
910 : : !! INPUTS
911 : : !!
912 : : !! SOURCE
913 : :
914 : 0 : function wff_usef90(wff)
915 : :
916 : : !Arguments ------------------------------------
917 : : !scalars
918 : : integer :: wff_usef90
919 : : type(wffile_type),intent(in) :: wff
920 : :
921 : : ! *************************************************************************
922 : :
923 : 0 : wff_usef90=0
924 [ # # # # : 0 : if (wff%iomode==IO_MODE_FORTRAN.or.(wff%iomode ==IO_MODE_FORTRAN_MASTER.and.wff%master==wff%me)) wff_usef90=1
# # ]
925 : :
926 : 0 : end function wff_usef90
927 : : !!***
928 : :
929 : : !----------------------------------------------------------------------
930 : :
931 : : !!****f* m_wffile/wff_ireadf90
932 : : !! NAME
933 : : !! wff_ireadf90
934 : : !!
935 : : !! FUNCTION
936 : : !! 1 if a Fortran file is going to be read by this node, 0 otherwise.
937 : : !!
938 : : !! INPUTS
939 : : !!
940 : : !! SOURCE
941 : :
942 : : function wff_ireadf90(wff)
943 : :
944 : : !Arguments ------------------------------------
945 : : !scalars
946 : : integer :: wff_ireadf90
947 : : type(wffile_type),intent(in) :: wff
948 : :
949 : : ! *************************************************************************
950 : :
951 : : wff_ireadf90=0
952 : : if (wff%iomode==IO_MODE_FORTRAN.or.(wff%iomode==IO_MODE_FORTRAN_MASTER.and.wff%master==wff%me)) wff_ireadf90=1
953 : :
954 : : end function wff_ireadf90
955 : : !!***
956 : :
957 : : !----------------------------------------------------------------------
958 : :
959 : : !!****f* m_wffile/WffOpen
960 : : !! NAME
961 : : !! WffOpen
962 : : !!
963 : : !! FUNCTION
964 : : !! This subroutine opens a Wf file. It might be accessed
965 : : !! by different mechanisms (usual F90 IO routines,
966 : : !! MPI I/O, or, in the future, NetCDF). The routine
967 : : !! provides a file handler, wff (a data structure containing
968 : : !! all needed information).
969 : : !!
970 : : !! INPUTS
971 : : !! iomode=access mode (0 means all procs access using usual F90
972 : : !! routines ; -1 means only the master proc access, using usual
973 : : !! F90 routines ; 1 means MPI I/O; 2 means netcdf I/O)
974 : : !! filename=name of the file
975 : : !! master=the number of the master proc (only needed in parallel)
976 : : !! me=my number (only needed in parallel)
977 : : !! spaceComm= the space communicator handler (only needed in MPI parallel I/O)
978 : : !! spaceWorld= the space communicator for the whole set of procs
979 : : !! unwff=the file unit number
980 : : !!
981 : : !! OUTPUT
982 : : !! ier=error code
983 : : !! wff= structured info about the wavefunction file
984 : : !!
985 : : !! SOURCE
986 : :
987 : 2412 : subroutine WffOpen(iomode,spaceComm,filename,ier,wff,master,me,unwff,&
988 : : & spaceComm_mpiio) ! optional argument
989 : :
990 : : !Arguments ------------------------------------
991 : : integer, intent(in) :: iomode,spaceComm,master,me,unwff
992 : : integer, intent(in),optional :: spaceComm_mpiio
993 : : integer, intent(out) :: ier
994 : : character(len=fnlen), intent(in) :: filename
995 : : type(wffile_type), intent(inout) :: wff !vz_i
996 : :
997 : : !Local variables-------------------------------
998 : : character(len=500) :: message
999 : : character(len=fnlen) :: fildata
1000 : : integer :: amode
1001 : : logical :: exists, read_only
1002 : : #ifdef HAVE_MPI_IO
1003 : : integer :: isize
1004 : : #endif
1005 : :
1006 : : ! *************************************************************************
1007 : :
1008 : : !Initialize the mandatory data of the wff datastructure
1009 : 2412 : wff%unwff =unwff
1010 [ + + ]: 2412 : wff%iomode =iomode; if (endswith(filename, ".nc")) wff%iomode = IO_MODE_ETSF
1011 [ + + ]: 2412 : if (filename/=wff%fname) wff%fname=filename
1012 : :
1013 : : !Initialize info useful for parallel use
1014 : 2412 : wff%nproc =1
1015 : 2412 : wff%master =master
1016 : 2412 : wff%me =me
1017 : 2412 : wff%me_mpiio =0
1018 : 2412 : wff%spaceComm=spaceComm
1019 : 2412 : wff%spaceComm_mpiio=xmpi_comm_self
1020 : :
1021 : : #if defined HAVE_MPI
1022 : : ! This case occurs when wff is connected to a DENSITY file
1023 : : ! abinit_comm_output is generally equal to MPI_COMM_WORLD (except if paral. over images)
1024 [ - + ]: 2412 : if (spaceComm==MPI_COMM_SELF) wff%spaceComm=abinit_comm_output
1025 : : ! if (spaceComm==MPI_COMM_SELF) wff%spaceComm=MPI_COMM_WORLD
1026 : 2412 : call MPI_COMM_SIZE(wff%spaceComm,wff%nproc,ier)
1027 : : ! Redefine the default MPIIO communicator if MPI, although MPIIO features should not be used unless
1028 : : ! present(spaceComm_mpiio).and.wff%iomode==1
1029 : 2412 : wff%spaceComm_mpiio=wff%spaceComm
1030 : 2412 : wff%me_mpiio=wff%me
1031 : : #endif
1032 : :
1033 [ + - + + ]: 2412 : if (present(spaceComm_mpiio).and.any(wff%iomode==[IO_MODE_MPI, IO_MODE_ETSF])) wff%spaceComm_mpiio=spaceComm_mpiio
1034 : : #if defined HAVE_MPI
1035 : 2412 : call MPI_COMM_RANK(wff%spaceComm_mpiio,wff%me_mpiio,ier)
1036 : : #endif
1037 : :
1038 : 2412 : ier=0
1039 [ - + ]: 2412 : if (wff%iomode==IO_MODE_FORTRAN) then ! All processors see a local file
1040 [ # # ]: 0 : if (open_file(filename, message, unit=unwff, form="unformatted") /= 0) then
1041 : 0 : ABI_ERROR(message)
1042 : : end if
1043 : 0 : rewind(unwff)
1044 : :
1045 [ + + ]: 2412 : else if (wff%iomode==IO_MODE_FORTRAN_MASTER) then ! Only the master processor see a local file
1046 [ + + ]: 132 : if(master==me)then
1047 [ - + ]: 112 : if (open_file(filename, message, unit=unwff, form="unformatted") /= 0) then
1048 : 0 : ABI_ERROR(message)
1049 : : end if
1050 : 112 : rewind(unwff)
1051 : : end if
1052 : :
1053 : : #if defined HAVE_MPI_IO
1054 [ + + ]: 2280 : else if (wff%iomode==IO_MODE_MPI)then ! In the parallel case, only the master open filename file
1055 [ + + ]: 32 : if(master==me)then
1056 [ - + ]: 27 : if (open_file(filename, message, unit=unwff, form="unformatted") /= 0) then
1057 : 0 : ABI_ERROR(message)
1058 : : end if
1059 : 27 : rewind(unwff)
1060 : : end if
1061 : : ! MG: Great! These barriers lead to a deadlock if prtded hence MPI_FILE_OPEN is not called by all the processors!
1062 : : !call xmpi_barrier(wff%spaceComm)
1063 : : !call xmpi_barrier(wff%spaceComm_mpiio)
1064 : :
1065 : : ! An existing file that cannot be written (e.g. in a read-only directory) can only be read:
1066 : : ! open it read-only, MPI_MODE_RDWR would fail with "Access denied".
1067 : : ! MPI_FILE_OPEN is collective and needs the same amode on all procs: master decides and broadcasts.
1068 : 32 : amode = MPI_MODE_CREATE + MPI_MODE_RDWR
1069 [ + + ]: 32 : if (master == me) then
1070 : 27 : inquire(file=filename, exist=exists)
1071 [ + - ]: 27 : if (exists) then
1072 [ - + ]: 27 : if (.not. clib_is_writable(filename)) amode = MPI_MODE_RDONLY
1073 : : end if
1074 : : end if
1075 : 32 : call xmpi_bcast(amode, master, wff%spaceComm, ier)
1076 : 32 : call MPI_FILE_OPEN(wff%spaceComm,filename,amode,MPI_INFO_NULL,wff%fhwff,ier)
1077 : 32 : ABI_CHECK_MPI(ier,sjoin("WffOpen:", filename))
1078 : :
1079 : : ! Define all type values
1080 : 32 : call MPI_Type_size(MPI_INTEGER,isize,ier)
1081 : 32 : wff%nbOct_int=isize
1082 : 32 : call MPI_Type_size(MPI_DOUBLE_PRECISION,isize,ier)
1083 : 32 : wff%nbOct_dp=isize
1084 : 32 : call MPI_Type_size(MPI_CHARACTER,isize,ier)
1085 : 32 : wff%nbOct_ch=isize
1086 : 32 : wff%nbOct_recMarker=-1;wff%kgwff=-1;wff%formwff=-1
1087 : 32 : wff%offwff=0;wff%off_recs=0;wff%lght_recs=0
1088 : : wff%marker_mpi_type=MPI_INTEGER ! Default value
1089 : :
1090 : : #ifdef DEV_DEBUG_THIS
1091 : 32 : wff%nbOct_recMarker=xmpio_bsize_frm
1092 : 32 : wff%marker_mpi_type=xmpio_mpi_type_frm
1093 : : #endif
1094 : :
1095 : : if (MPI_OFFSET_KIND==4) then
1096 : : wff%offset_mpi_type=MPI_INTEGER4
1097 : : else if (MPI_OFFSET_KIND==8) then
1098 : 32 : wff%offset_mpi_type=MPI_INTEGER8
1099 : : #if defined HAVE_FC_INT_QUAD && defined HAVE_MPI_INTEGER16
1100 : : else if (MPI_OFFSET_KIND==16) then
1101 : : wff%offset_mpi_type=MPI_INTEGER16
1102 : : #endif
1103 : : else if (MPI_OFFSET_KIND==2) then
1104 : : wff%offset_mpi_type=MPI_INTEGER2
1105 : : end if
1106 : : #endif
1107 : :
1108 [ + - ]: 2248 : else if (wff%iomode==IO_MODE_ETSF)then
1109 : 2248 : fildata = nctk_ncify(filename)
1110 : : ! As for MPI-IO: an existing file that cannot be written is opened read-only
1111 : : ! (nctk_open_modify asks for write access and fails with "HDF error").
1112 : 2248 : inquire(file=fildata, exist=exists)
1113 : 2248 : read_only = .False.
1114 [ + - ]: 2248 : if (exists) read_only = .not. clib_is_writable(fildata)
1115 [ - + ]: 2248 : if (read_only) then
1116 [ # # ]: 0 : NCF_CHECK(nctk_open_read(wff%unwff, fildata, xmpi_comm_self))
1117 : : else
1118 [ - + ]: 2248 : NCF_CHECK(nctk_open_modify(wff%unwff, fildata, xmpi_comm_self))
1119 : : end if
1120 : 2248 : wff%fname = fildata
1121 : : !write(message,'(3A,I0)')'WffOpen: opening ', trim(wff%fname)," on unit ", wff%unwff
1122 : : !call wrtout(std_out, message, 'COLL')
1123 : : else
1124 : : write(message, '(7a,i0,3a)' )&
1125 : 0 : & 'For the time being the input variable iomode is restricted ',ch10,&
1126 : 0 : & 'to 0 (all cases), 1 (in case MPI is enabled),',ch10,&
1127 : 0 : & 'or 3 (only sequential, and if the NetCDF and ETSF_IO libraries have been enabled).',ch10,&
1128 : 0 : & 'Its value is iomode= ',wff%iomode,'.',ch10,&
1129 : 0 : & 'Action: change iomode or use ABINIT in parallel or enable NetCDF and/or ETSF_IO.'
1130 : 0 : ABI_ERROR(message)
1131 : : end if
1132 : :
1133 : 2412 : end subroutine WffOpen
1134 : : !!***
1135 : :
1136 : : !----------------------------------------------------------------------
1137 : :
1138 : : !!****f* m_wffile/WffClose
1139 : : !! NAME
1140 : : !! WffClose
1141 : : !!
1142 : : !! FUNCTION
1143 : : !! This subroutine closes a Wf file.
1144 : : !!
1145 : : !! INPUTS
1146 : : !! wff= structured info about the wavefunction file
1147 : : !!
1148 : : !! OUTPUT
1149 : : !! ierr=error code
1150 : : !!
1151 : : !! SOURCE
1152 : :
1153 : 2412 : subroutine WffClose(wff,ier)
1154 : :
1155 : : !Arguments ------------------------------------
1156 : : type(wffile_type), intent(inout) :: wff
1157 : : integer, intent(out) :: ier
1158 : :
1159 : : ! *************************************************************************
1160 : :
1161 : 2412 : ier=0
1162 [ - + ]: 2412 : if(wff%iomode==IO_MODE_FORTRAN) then ! All processors see a local file
1163 : 0 : close(unit=wff%unwff)
1164 : :
1165 [ + + ]: 2412 : else if(wff%iomode == IO_MODE_ETSF)then
1166 [ - + ]: 2248 : NCF_CHECK(nf90_close(wff%unwff))
1167 : :
1168 [ + + ]: 164 : else if(wff%iomode==IO_MODE_FORTRAN_MASTER)then ! Only the master processor see a local file
1169 [ + + ]: 132 : if(wff%master==wff%me) close (unit=wff%unwff) ! VALGRIND complains buf points to uninitialized bytes
1170 : :
1171 : : #if defined HAVE_MPI_IO
1172 [ + - ]: 32 : else if(wff%iomode==IO_MODE_MPI)then
1173 : 32 : call MPI_FILE_CLOSE(wff%fhwff,ier)
1174 [ + + ]: 32 : if (wff%master==wff%me ) close(unit=wff%unwff)
1175 : 32 : wff%offwff=0;wff%off_recs=0;wff%lght_recs=0
1176 : 32 : wff%nbOct_recMarker=-1
1177 : 32 : wff%kgwff=-1
1178 : : #endif
1179 : :
1180 : : end if
1181 : :
1182 : 2412 : end subroutine WffClose
1183 : : !!***
1184 : :
1185 : : !----------------------------------------------------------------------
1186 : :
1187 : : !!****f* m_wffile/WffDelete
1188 : : !! NAME
1189 : : !! WffDelete
1190 : : !!
1191 : : !! FUNCTION
1192 : : !! This subroutine closes a Wf file, and delete it.
1193 : : !!
1194 : : !! INPUTS
1195 : : !! wff= structured info about the wavefunction file
1196 : : !!
1197 : : !! OUTPUT
1198 : : !! ierr=error code
1199 : : !!
1200 : : !! SOURCE
1201 : :
1202 : 0 : subroutine WffDelete(wff,ier)
1203 : :
1204 : : !Arguments ------------------------------------
1205 : : type(wffile_type),intent(inout) :: wff
1206 : : integer, intent(out) :: ier
1207 : :
1208 : : ! *************************************************************************
1209 : :
1210 : 0 : ier=0
1211 [ # # ]: 0 : if (wff%iomode==IO_MODE_FORTRAN) then ! All processors see a local file
1212 : 0 : close(unit=wff%unwff,status='delete')
1213 : :
1214 [ # # ]: 0 : else if (wff%iomode==IO_MODE_FORTRAN_MASTER)then ! Only the master processor see a local file
1215 [ # # ]: 0 : if (wff%master==wff%me) close (unit=wff%unwff,status='delete')
1216 : :
1217 : :
1218 [ # # ]: 0 : else if (wff%iomode==IO_MODE_MPI)then
1219 : : #if defined HAVE_MPI_IO
1220 [ # # ]: 0 : if ( wff%fhwff /= -1 )then
1221 : 0 : call MPI_FILE_CLOSE(wff%fhwff,ier)
1222 : : end if
1223 [ # # ]: 0 : if (wff%master==wff%me ) then
1224 : 0 : close(unit=wff%unwff,status='delete')
1225 : 0 : wff%fhwff = -1
1226 : : end if
1227 : 0 : wff%offwff=0;wff%off_recs=0;wff%lght_recs=0
1228 : 0 : wff%nbOct_recMarker=-1
1229 : 0 : wff%kgwff=-1
1230 : : #endif
1231 : : end if
1232 : :
1233 : 0 : end subroutine WffDelete
1234 : : !!***
1235 : :
1236 : : !----------------------------------------------------------------------
1237 : :
1238 : : !!****f* m_wffile/WffKg
1239 : : !! NAME
1240 : : !! WffKg
1241 : : !!
1242 : : !! FUNCTION
1243 : : !! Check kgwff to manage WF file in the MPI/IO case
1244 : : !!
1245 : : !! INPUTS
1246 : : !! wff <type(wffile_type)> = structured info about the wavefunction file
1247 : : !! optkg= if 1 , read or write kg_k ; if 0,do not care about kg_k in rwwf
1248 : : !!
1249 : : !! OUTPUT
1250 : : !!
1251 : : !! SOURCE
1252 : :
1253 : 160 : subroutine WffKg(wff,optkg)
1254 : :
1255 : : !Arguments ------------------------------------
1256 : : type(wffile_type),intent(inout) :: wff
1257 : : integer,intent(in) :: optkg
1258 : :
1259 : : ! *********************************************************************
1260 : :
1261 : : #if defined HAVE_MPI_IO
1262 [ + + ]: 160 : if (wff%iomode == IO_MODE_MPI) wff%kgwff=optkg
1263 : : #else
1264 : : ABI_UNUSED((/wff%iomode,optkg/))
1265 : : #endif
1266 : :
1267 : 160 : end subroutine WffKg
1268 : : !!***
1269 : :
1270 : : !----------------------------------------------------------------------
1271 : :
1272 : : !!****f* ABINIT/WffOffset
1273 : : !! NAME
1274 : : !! WffOffset
1275 : : !!
1276 : : !! FUNCTION
1277 : : !! Tool to manage WF file in the MPI/IO case : broadcast the offset of
1278 : : !! the first k-point data block
1279 : : !!
1280 : : !! INPUTS
1281 : : !! wff <type(wffile_type)> = structured info about the wavefunction file
1282 : : !! sender = id of the sender
1283 : : !! spaceComm = id of the space communicator handler
1284 : : !!
1285 : : !! OUTPUT
1286 : : !! ier = error code returned by the MPI call
1287 : : !!
1288 : : !! SOURCE
1289 : :
1290 : 592 : subroutine WffOffset(wff,sender,spaceComm,ier)
1291 : :
1292 : : !Arguments ------------------------------------
1293 : : type(wffile_type),intent(inout) :: wff
1294 : : integer ,intent(inout) :: sender
1295 : : integer ,intent(in) :: spaceComm
1296 : : integer ,intent(out) :: ier
1297 : :
1298 : : !Local variables ------------------------------
1299 : : #if defined HAVE_MPI_IO
1300 : : integer :: icom
1301 : : integer(kind=MPI_OFFSET_KIND) :: off(1)
1302 : : #endif
1303 : :
1304 : : ! *********************************************************************
1305 : :
1306 : : #if defined HAVE_MPI_IO
1307 [ + + ]: 592 : if (wff%iomode == IO_MODE_MPI) then
1308 : 60 : call xmpi_max(sender,icom,spaceComm,ier)
1309 [ + - ]: 60 : if (icom>=0)then
1310 : 60 : off(1)=wff%offwff
1311 : 60 : call MPI_BCAST(off,1,wff%offset_mpi_type,icom,spaceComm,ier)
1312 : 60 : wff%offwff=off(1)
1313 : : end if
1314 : : end if ! iomode
1315 : : #else
1316 : : ier = 0
1317 : : ABI_UNUSED((/wff%iomode,sender,spaceComm/))
1318 : : #endif
1319 : :
1320 : 592 : end subroutine WffOffset
1321 : : !!***
1322 : :
1323 : : !----------------------------------------------------------------------
1324 : :
1325 : : !!****f* m_wffile/WffReadDataRec_dp1d
1326 : : !! NAME
1327 : : !! WffReadDataRec_dp1d
1328 : : !!
1329 : : !! FUNCTION
1330 : : !! Subroutine to read data in one record of a wavefunction file
1331 : : !! Handles double precision 1D arrays
1332 : : !!
1333 : : !! INPUTS
1334 : : !! ndp=size of the double precision array to be read
1335 : : !! wff= structured info about the wavefunction file
1336 : : !!
1337 : : !! OUTPUT
1338 : : !! dparray=array of double precision numbers
1339 : : !! ierr=error code
1340 : : !!
1341 : : !! SIDE EFFECTS
1342 : : !!
1343 : : !! SOURCE
1344 : :
1345 : 0 : subroutine WffReadDataRec_dp1d(dparray,ierr,ndp,wff)
1346 : :
1347 : : !Arguments ------------------------------------
1348 : : type(wffile_type),intent(inout) :: wff
1349 : : integer,intent(in) :: ndp
1350 : : integer,intent(out) :: ierr
1351 : : real(dp),intent(out) :: dparray(ndp)
1352 : :
1353 : : !Local variables-------------------------------
1354 : : character(len=500) :: msg
1355 : :
1356 : : ! *************************************************************************
1357 : :
1358 : 0 : ierr=0
1359 [ # # # # : 0 : if (wff%iomode==IO_MODE_FORTRAN.or.(wff%iomode==IO_MODE_FORTRAN_MASTER.and.wff%master==wff%me)) then
# # ]
1360 : 0 : read (wff%unwff,iostat=ierr) dparray(1:ndp)
1361 : :
1362 [ # # ]: 0 : else if(wff%iomode==IO_MODE_MPI)then
1363 : : #if defined HAVE_MPI_IO
1364 : 0 : call xderiveRRecInit(wff,ierr)
1365 : 0 : call xderiveRead(wff,dparray,ndp,MPI_COMM_SELF,ierr)
1366 : 0 : call xderiveRRecEnd(wff,ierr)
1367 : : #endif
1368 : : else
1369 : 0 : write(msg,'(a,i0)')"Wrong iomode: ",wff%iomode
1370 : 0 : ABI_ERROR(msg)
1371 : : end if
1372 : :
1373 : 0 : end subroutine WffReadDataRec_dp1d
1374 : : !!***
1375 : :
1376 : : !----------------------------------------------------------------------
1377 : :
1378 : :
1379 : : !!****f* m_wffile/WffReadDataRec_dp2d
1380 : : !! NAME
1381 : : !! WffReadDataRec_dp2d
1382 : : !!
1383 : : !! FUNCTION
1384 : : !! Subroutine to read data in one record of a wavefunction file
1385 : : !! Handles double precision 2D arrays
1386 : : !!
1387 : : !! INPUTS
1388 : : !! n1,n2=sizes of the double precision array to be read
1389 : : !! wff= structured info about the wavefunction file
1390 : : !!
1391 : : !! OUTPUT
1392 : : !! dparray=array of double precision numbers
1393 : : !! ierr=error code
1394 : : !!
1395 : : !! SIDE EFFECTS
1396 : : !!
1397 : : !! SOURCE
1398 : :
1399 : 0 : subroutine WffReadDataRec_dp2d(dparray,ierr,n1,n2,wff)
1400 : :
1401 : : !Arguments ------------------------------------
1402 : : type(wffile_type),intent(inout) :: wff
1403 : : integer,intent(in) :: n1,n2
1404 : : integer,intent(out) :: ierr
1405 : : real(dp),intent(out) :: dparray(n1,n2)
1406 : :
1407 : : !Local variables-------------------------------
1408 : : character(len=500) :: msg
1409 : :
1410 : : ! *************************************************************************
1411 : :
1412 : 0 : ierr=0
1413 [ # # # # : 0 : if (wff%iomode==IO_MODE_FORTRAN.or.(wff%iomode==IO_MODE_FORTRAN_MASTER.and.wff%master==wff%me)) then
# # ]
1414 : 0 : read (wff%unwff,iostat=ierr) dparray(1:n1,1:n2)
1415 : :
1416 [ # # ]: 0 : else if(wff%iomode==IO_MODE_MPI)then
1417 : : #if defined HAVE_MPI_IO
1418 : 0 : call xderiveRRecInit(wff,ierr)
1419 : 0 : call xderiveRead(wff,dparray,n1,n2,MPI_COMM_SELF,ierr)
1420 : 0 : call xderiveRRecEnd(wff,ierr)
1421 : : #endif
1422 : : else
1423 : 0 : write(msg,'(a,i0)')"Wrong iomode: ",wff%iomode
1424 : 0 : ABI_ERROR(msg)
1425 : : end if
1426 : :
1427 : 0 : end subroutine WffReadDataRec_dp2d
1428 : : !!***
1429 : :
1430 : : !----------------------------------------------------------------------
1431 : :
1432 : : !!****f* m_wffile/WffReadNpwRec
1433 : : !! NAME
1434 : : !! WffReadNpwRec
1435 : : !!
1436 : : !! FUNCTION
1437 : : !! This subroutine read the npw record of a wavefunction file
1438 : : !!
1439 : : !! INPUTS
1440 : : !! wff= structured info about the wavefunction file
1441 : : !! wff%access == -1 and wf%master == Wff%me:
1442 : : !! read binary data
1443 : : !! wff%iomode == 0:
1444 : : !! read binary data
1445 : : !! wff%iomode == 1:
1446 : : !! use MPI/IO routines (MPIO defined)
1447 : : !! wff%iomode == 2:
1448 : : !! read netcdf format (NETCDF defined)
1449 : : !! ikpt= the i-th kpoint.
1450 : : !! isppol= the given spin polarisation element.
1451 : : !!
1452 : : !! OUTPUT
1453 : : !! ierr=error code (iostat integer from read statement)
1454 : : !! nband_disk=number of bands
1455 : : !! npw=number of plane waves
1456 : : !! nspinor=number of spinorial components of the wavefunctions
1457 : : !!
1458 : : !! SIDE EFFECTS
1459 : : !!
1460 : : !! SOURCE
1461 : :
1462 : 63806 : subroutine WffReadNpwRec(ierr,ikpt,isppol,nband_disk,npw,nspinor,wff)
1463 : :
1464 : : !Arguments ------------------------------------
1465 : : type(wffile_type),intent(inout) :: wff
1466 : : integer,intent(in) :: ikpt, isppol
1467 : : integer,intent(out) :: ierr,nband_disk,npw,nspinor
1468 : :
1469 : : !Local variables-------------------------------
1470 : : !character(len=500) :: msg
1471 : : integer :: vid
1472 : : ! *************************************************************************
1473 : :
1474 : 63806 : ierr=0
1475 : :
1476 [ + - - + : 63806 : if (wff%iomode == IO_MODE_FORTRAN.or.(wff%iomode==IO_MODE_FORTRAN_MASTER.and.wff%master==wff%me) ) then
- - ]
1477 : 0 : read (wff%unwff,iostat=ierr) npw,nspinor,nband_disk
1478 : :
1479 [ + + ]: 63806 : else if(wff%iomode==IO_MODE_MPI)then
1480 : : #if defined HAVE_MPI_IO
1481 : 16 : call xderiveRRecInit(wff,ierr)
1482 : 16 : call xderiveRead(wff,npw,ierr)
1483 : 16 : call xderiveRead(wff,nspinor,ierr)
1484 : 16 : call xderiveRead(wff,nband_disk,ierr)
1485 : 16 : call xderiveRRecEnd(wff,ierr)
1486 : : #endif
1487 : :
1488 [ + - ]: 63790 : else if (wff%iomode == IO_MODE_ETSF) then
1489 : :
1490 : : !write(std_out,*)"readnpwrec: ikpt, spin", ikpt, spin
1491 [ - + ]: 63790 : NCF_CHECK(nctk_get_dim(wff%unwff, "number_of_spinor_components", nspinor))
1492 : 63790 : vid = nctk_idname(wff%unwff, "number_of_coefficients")
1493 [ + + - + : 127580 : NCF_CHECK(nf90_get_var(wff%unwff, vid, npw, start=[ikpt]))
- - ]
1494 : 63790 : vid = nctk_idname(wff%unwff, "number_of_states")
1495 [ + + - + : 191370 : NCF_CHECK(nf90_get_var(wff%unwff, vid, nband_disk, start=[ikpt, isppol]))
- - ]
1496 : :
1497 : : else
1498 : : ! MG: I don't understand why we have to use this ugly code!!!!!!!!
1499 : : ! Only master knows npw,nspinor,nband_disk in IO_MODE_FORTRAN_MASTE mode
1500 : : ! To the person who wrote this stuff:
1501 : : ! Have you ever heard about the "IF" statement of Fortran and the typical construct
1502 : : !
1503 : : ! if (rank==master) call mpifoo_seq()
1504 : :
1505 : 0 : ABI_WARNING("Skipping read in WffReadNpwRec. Keep fingers crossed")
1506 : : ! MG: Must initialze these values somehow to avoid overflows.
1507 : 0 : npw = 0; nspinor = 0; nband_disk = 0
1508 : : end if
1509 : :
1510 : : !write(std_out,*)"nband_disk,npw,nspinor",nband_disk,npw,nspinor
1511 [ - + ]: 63806 : ABI_CHECK(ierr==0,"ierr!=0")
1512 : :
1513 : 63806 : end subroutine WffReadNpwRec
1514 : : !!***
1515 : :
1516 : : !----------------------------------------------------------------------
1517 : :
1518 : : !!****f* m_wffile/WffReadSkipRec
1519 : : !! NAME
1520 : : !! WffReadSkipRec
1521 : : !!
1522 : : !! FUNCTION
1523 : : !! This subroutine move forward or backward in a Wf file by nrec records.
1524 : : !!
1525 : : !! INPUTS
1526 : : !! nrec=number of records
1527 : : !! wff= structured info about the wavefunction file
1528 : : !!
1529 : : !! OUTPUT
1530 : : !! ierr=error code
1531 : : !!
1532 : : !! TODO
1533 : : !! For the future : one should treat the possible errors of backspace
1534 : : !!
1535 : : !! SOURCE
1536 : :
1537 : :
1538 : 63878 : subroutine WffReadSkipRec(ierr,nrec,wff)
1539 : :
1540 : : !Arguments ------------------------------------
1541 : : integer,intent(in) :: nrec
1542 : : integer,intent(out) :: ierr
1543 : : type(wffile_type),intent(inout) :: wff
1544 : :
1545 : : !Local variables-------------------------------
1546 : : #if defined HAVE_MPI_IO
1547 : : integer :: irec
1548 : : integer(kind=MPI_OFFSET_KIND) :: delim_record,offset
1549 : : #endif
1550 : :
1551 : : ! *************************************************************************
1552 : :
1553 : 63878 : ierr=0
1554 [ + - - + : 63878 : if( wff%iomode==IO_MODE_FORTRAN.or.(wff%iomode==IO_MODE_FORTRAN_MASTER.and.wff%master==wff%me)) then
- - ]
1555 : :
1556 : 0 : call mvrecord(wff%unwff,nrec,ierr)
1557 [ # # ]: 0 : ABI_CHECK(ierr==0,"error in mvrecord")
1558 : :
1559 : :
1560 [ + + ]: 63878 : else if(wff%iomode==IO_MODE_MPI)then
1561 : : #if defined HAVE_MPI_IO
1562 [ + - ]: 16 : if (nrec>0) then ! Move forward nrec records
1563 [ + + ]: 32 : do irec=1,nrec
1564 : 16 : wff%off_recs = wff%offwff
1565 : 16 : call rwRecordMarker(1,wff%offwff,delim_record,wff,ierr)
1566 : 32 : wff%lght_recs = delim_record
1567 : : end do
1568 : : else ! Move backward -nrec records
1569 [ # # ]: 0 : do irec=1,-nrec
1570 : 0 : offset = wff%offwff-wff%nbOct_recMarker
1571 : 0 : call rwRecordMarker(1,offset,delim_record,wff,ierr)
1572 : 0 : wff%lght_recs = delim_record
1573 : 0 : wff%offwff = wff%offwff - delim_record - 2*wff%nbOct_recMarker
1574 : 0 : wff%off_recs = wff%offwff
1575 : : end do
1576 : : end if
1577 : : #endif
1578 : : end if ! wff%iomode==0,1 or -1
1579 : :
1580 : 63878 : end subroutine WffReadSkipRec
1581 : : !!***
1582 : :
1583 : : !----------------------------------------------------------------------
1584 : :
1585 : : !!****f* m_wffile/WffReadWrite_mpio
1586 : : !! NAME
1587 : : !! WffReadWrite_mpio
1588 : : !!
1589 : : !! FUNCTION
1590 : : !! This procedure read or write cg in the file _WFK using MPI_IO
1591 : : !! when cg are dispatched amoung commcart communicator
1592 : : !!
1593 : : !! INPUTS
1594 : : !! wff=struct info for wavefunction
1595 : : !! nband_disk=number of bands on disk files to be write
1596 : : !! icg=shift to be given to the location of the cg array
1597 : : !! mcg=second dimention of cg
1598 : : !! mpi_enreg=information about parallelisation
1599 : : !! depl_mpi_to_seq=for each proc, index of cg in sequential mode
1600 : : !! npwso=npw*nspinor number of plane waves treated by this node.
1601 : : !! npwsotot=npwtot*nspinor Total number of planewaves Used to calculate the size of data to be written.
1602 : : !! rdwr=1 if reading, 2 if writing
1603 : : !!
1604 : : !! OUTPUT
1605 : : !! ierr=error status
1606 : : !!
1607 : : !! SIDE EFFECTS
1608 : : !! cg(2,mcg)=planewave coefficients of wavefunctions,
1609 : : !!
1610 : : !! NOTES
1611 : : !! cg is written like the following:
1612 : : !! BeginMarker cg ( iband = 1 ) EndMarker
1613 : : !! BeginMarker cg ( iband = 2 ) EndMarker
1614 : : !! ...
1615 : : !! BeginMarker cg( iband = nband_disk ) EndMarker
1616 : : !!
1617 : : !! BeginMarker and EndMarker give the value of the total length of cg for one band
1618 : : !!
1619 : : !! For MPI-IO library the performance is improved by the use a "view" of the file for each proc.
1620 : :
1621 : : !! SOURCE
1622 : :
1623 : 68 : subroutine WffReadWrite_mpio(wff,rdwr,cg,mcg,icg,nband_disk,npwso,npwsotot,depl_mpi_to_seq,ierr)
1624 : :
1625 : : !Arguments ------------------------------------
1626 : : !scalars
1627 : : integer,intent(in) :: icg,mcg,nband_disk,npwso,npwsotot,rdwr
1628 : : integer,intent(out) :: ierr
1629 : : type(wffile_type),intent(inout) :: wff
1630 : : !arrays
1631 : : integer,intent(in) :: depl_mpi_to_seq(npwso)
1632 : : real(dp),intent(inout) :: cg(2,mcg)
1633 : :
1634 : : !Local variables-------------------------------
1635 : : !scalars
1636 : : #if defined HAVE_MPI_IO
1637 : : integer,parameter :: MAXBAND=500, check_markers=1
1638 : : integer :: filetype,iband,ibandmax,ibandmin,iblock,ii,iloc,ipw,jerr,jj
1639 : : integer :: nb,nband_block,step,totsize1bandcg,wfftempo
1640 : : integer(kind=MPI_OFFSET_KIND) :: delim_record,loc_depl_band,offset,totsize1bandByte
1641 : : character(len=500) :: msg
1642 : : !arrays
1643 : 68 : integer,allocatable :: BlockLength(:),BlockType(:),map(:),tempo_map(:)
1644 : 68 : integer(kind=MPI_OFFSET_KIND),allocatable :: BlockDepl(:)
1645 : 68 : integer(kind=2),allocatable :: bufdelim2(:)
1646 : 68 : integer(kind=4),allocatable :: bufdelim4(:)
1647 : 68 : integer(kind=8),allocatable :: bufdelim8(:)
1648 : 68 : real(dp),allocatable :: buf(:),tempo_buf(:)
1649 : : #if defined HAVE_FC_INT_QUAD
1650 : 68 : integer(kind=16),allocatable :: bufdelim16(:)
1651 : : #endif
1652 : : #endif
1653 : :
1654 : : ! *********************************************************************
1655 : :
1656 : 68 : ierr=0
1657 : :
1658 : : #if defined HAVE_MPI_IO
1659 : : !----------------------------------------------
1660 : : !! Prepare WF data
1661 : : !----------------------------------------------
1662 : : !Init offset of record
1663 : 68 : wff%off_recs = wff%offwff
1664 : :
1665 : : !Total size to be written (in number of bands and in bytes)
1666 : 68 : totsize1bandcg=2*npwsotot
1667 : : !call xmpi_sum(totsize1bandcg,wff%spaceComm_mpiio,ierr)
1668 : :
1669 : 68 : totsize1bandByte=totsize1bandcg*wff%nbOct_dp+2*wff%nbOct_recMarker
1670 : :
1671 : : !Check file size
1672 : 68 : offset=wff%offwff+nband_disk*totsize1bandByte
1673 : : if (offset>Huge(offset)) then
1674 : : msg='File is too large for MPI-IO specifications !'
1675 : : ABI_ERROR(msg)
1676 : : end if
1677 : :
1678 : : !Open file (read-only when reading: the file may not be writable)
1679 [ + + ]: 68 : if (rdwr==1) then
1680 : 16 : call MPI_FILE_OPEN(wff%spaceComm_mpiio,wff%fname,MPI_MODE_RDONLY,MPI_INFO_NULL,wfftempo,ierr)
1681 : : else
1682 : 52 : call MPI_FILE_OPEN(wff%spaceComm_mpiio,wff%fname,MPI_MODE_RDWR,MPI_INFO_NULL,wfftempo,ierr)
1683 : : end if
1684 : 68 : ABI_CHECK_MPI(ierr, sjoin("MPI_FILE_OPEN:", wff%fname))
1685 : :
1686 : : !----------------------------------------------------------
1687 : : !Loop blocks of bands (to decrease offsets inside the file)
1688 : : !----------------------------------------------------------
1689 : 68 : ibandmax=0;ibandmin=1
1690 : 68 : ii=huge(check_markers)/totsize1bandByte;step=min(ii,MAXBAND,nband_disk)
1691 [ + - ]: 68 : do iblock=1,nband_disk/step+1
1692 : 68 : ibandmax=min(ibandmin+step-1,nband_disk)
1693 : 68 : nband_block=ibandmax-ibandmin+1
1694 : 68 : offset=wff%offwff+(ibandmin-1)*totsize1bandByte
1695 : :
1696 : : ! ----------------------------------------------
1697 : : ! Read/Write bands
1698 : : ! ----------------------------------------------
1699 : :
1700 : : ! Build map; for better performance, map must be in increasing order
1701 [ + - - + : 204 : ABI_MALLOC_OR_DIE(map,(2*npwso*nband_block), ierr)
+ - + - +
- + - - +
- + ]
1702 : :
1703 [ - + + - : 204 : ABI_STAT_MALLOC(buf,(2*npwso*nband_block), ierr)
+ - + - +
- - + ]
1704 [ - + ]: 68 : ABI_CHECK(ierr==0, "out of memory in wavefunction buffer. Try to decrease MAXBAND in WffReadWrite_mpio")
1705 : :
1706 [ + + ]: 68 : if (rdwr==1) then
1707 : : ! If reading, only build map
1708 : 16 : nb=0;loc_depl_band=0
1709 [ + - - + : 48 : ABI_MALLOC(tempo_map,(2*npwso))
+ - + - +
- - + - +
- + ]
1710 [ + + ]: 816 : do iband=ibandmin,ibandmax
1711 [ + + ]: 131200 : tempo_map(1:2*npwso)=-1
1712 : 66000 : jj=1;ipw=(iband-1)*npwso+icg
1713 [ + + ]: 66000 : do ii=1,npwso
1714 : 65200 : iloc=loc_depl_band+wff%nbOct_recMarker+2*(depl_mpi_to_seq(ii)-1)*wff%nbOct_dp
1715 : 65200 : tempo_map(jj )=iloc ! Real part
1716 : 65200 : tempo_map(jj+1)=iloc+wff%nbOct_dp ! Imag part
1717 : 66000 : jj=jj+2
1718 : : end do
1719 [ + + ]: 131200 : do ii=1,2*npwso ! Now, elimate holes
1720 [ + - ]: 131200 : if (tempo_map(ii)/=-1) then
1721 : 130400 : nb=nb+1
1722 : 130400 : map(nb)=tempo_map(ii)
1723 : : end if
1724 : : end do
1725 : 816 : loc_depl_band=loc_depl_band+totsize1bandByte ! Location in bytes
1726 : : end do
1727 [ + - ]: 52 : else if (rdwr==2) then
1728 : : ! If writing, build map and store cg in a buffer
1729 : 52 : nb=0;loc_depl_band=0
1730 [ + - - + : 156 : ABI_MALLOC(tempo_map,(2*npwso))
+ - + - +
- - + - +
- + ]
1731 [ - + + - : 156 : ABI_MALLOC(tempo_buf,(2*npwso))
+ - + - -
+ - + ]
1732 [ + + ]: 1572 : do iband=ibandmin,ibandmax
1733 [ + + ]: 622384 : tempo_map(1:2*npwso)=-1
1734 : 1520 : jj=1;ipw=(iband-1)*npwso+icg
1735 [ + + ]: 311952 : do ii=1,npwso
1736 : 310432 : iloc=loc_depl_band+wff%nbOct_recMarker+2*(depl_mpi_to_seq(ii)-1)*wff%nbOct_dp
1737 : 310432 : tempo_map(jj )=iloc ! Real part
1738 : 310432 : tempo_map(jj+1)=iloc+wff%nbOct_dp ! Imag part
1739 [ + + ]: 931296 : tempo_buf(jj:jj+1)=cg(1:2,ipw+ii)
1740 : 311952 : jj=jj+2
1741 : : end do
1742 [ + + ]: 622384 : do ii=1,2*npwso ! Now, elimate holes
1743 [ + - ]: 622384 : if (tempo_map(ii)/=-1) then
1744 : 620864 : nb=nb+1
1745 : 620864 : map(nb)=tempo_map(ii)
1746 : 620864 : buf(nb)=tempo_buf(ii)
1747 : : end if
1748 : : end do
1749 : 1572 : loc_depl_band=loc_depl_band+totsize1bandByte ! Location in bytes
1750 : : end do
1751 [ - + ]: 52 : ABI_FREE(tempo_map)
1752 [ - + ]: 52 : ABI_FREE(tempo_buf)
1753 : : end if ! rdwr
1754 : :
1755 : : ! Build and commit MPI datatype
1756 [ + - - + : 204 : ABI_MALLOC(BlockLength,(nb+2))
+ - + - +
- - + -
+ ]
1757 [ - + + - : 204 : ABI_MALLOC(BlockDepl,(nb+2))
+ - + - -
+ - + ]
1758 [ - + + - : 136 : ABI_MALLOC(BlockType,(nb+2))
- + - + ]
1759 : 68 : BlockLength(1)=1;BlockDepl(1)=0;BlockType(1)=MPI_LB
1760 [ + + ]: 751332 : do ii=2,nb+1
1761 : 751264 : BlockLength(ii)=1
1762 : 751264 : BlockDepl(ii)=map(ii-1)
1763 : 751332 : BlockType(ii)=MPI_DOUBLE_PRECISION
1764 : : end do
1765 : 68 : BlockLength(nb+2)=1;BlockDepl(nb+2)=totsize1bandByte*nband_block;BlockType(nb+2)=MPI_UB
1766 : 68 : call xmpio_type_struct(nb+2,BlockLength,BlockDepl,BlockType,filetype,ierr)
1767 : 68 : call MPI_TYPE_COMMIT(filetype,ierr)
1768 : 68 : ABI_FREE(BlockLength)
1769 : 68 : ABI_FREE(BlockDepl)
1770 : 68 : ABI_FREE(BlockType)
1771 : :
1772 : : ! Read/Write data on disk
1773 : 68 : call MPI_FILE_SET_VIEW(wfftempo,offset,MPI_BYTE,filetype,"native",MPI_INFO_NULL,ierr)
1774 [ + + ]: 68 : if (rdwr==1) then
1775 : 16 : call MPI_FILE_READ_ALL (wfftempo,buf,nb,MPI_DOUBLE_PRECISION,MPI_STATUS_IGNORE,ierr)
1776 : : else
1777 : 52 : call MPI_FILE_WRITE_ALL(wfftempo,buf,nb,MPI_DOUBLE_PRECISION,MPI_STATUS_IGNORE,ierr)
1778 : : end if
1779 : :
1780 : : ! In case of reading, retrieve cg
1781 [ + + ]: 68 : if (rdwr==1) then
1782 : 16 : nb=0;loc_depl_band=0
1783 [ + - - + : 48 : ABI_MALLOC(tempo_buf,(2*npwso))
+ - + - +
- - + -
+ ]
1784 [ + + ]: 816 : do iband=ibandmin,ibandmax
1785 [ + + ]: 131200 : do ii=1,2*npwso ! Now, elimate holes
1786 [ + - ]: 131200 : if (tempo_map(ii)/=-1) then
1787 : 130400 : nb=nb+1;tempo_buf(ii)=buf(nb)
1788 : : end if
1789 : : end do
1790 : 800 : jj=1;ipw=(iband-1)*npwso+icg
1791 [ + + ]: 66000 : do ii=1,npwso
1792 : 65200 : iloc=loc_depl_band+wff%nbOct_recMarker+2*(depl_mpi_to_seq(ii)-1)*wff%nbOct_dp
1793 [ + + ]: 195600 : cg(1:2,ipw+ii)=tempo_buf(jj:jj+1)
1794 : 66000 : jj=jj+2
1795 : : end do
1796 : 816 : loc_depl_band=loc_depl_band+totsize1bandByte ! Location in bytes
1797 : : end do
1798 [ - + ]: 16 : ABI_FREE(tempo_map)
1799 [ - + ]: 16 : ABI_FREE(tempo_buf)
1800 : : end if ! rdwr
1801 : :
1802 : : ! Free memory
1803 [ - + ]: 68 : ABI_FREE(map)
1804 [ - + ]: 68 : ABI_FREE(buf)
1805 : 68 : call MPI_TYPE_FREE(filetype,ierr)
1806 : :
1807 : : ! ----------------------------------------------
1808 : : ! Check/Write record markers (only master proc)
1809 : : ! ----------------------------------------------
1810 [ + - ]: 68 : if ((rdwr==1.and.check_markers==1).or.(rdwr==2)) then
1811 : :
1812 : : ! Define view for the file
1813 : 68 : nb=2*nband_block
1814 [ + - - + : 204 : ABI_MALLOC(BlockLength,(nb+2))
+ - + - +
- - + -
+ ]
1815 [ - + + - : 204 : ABI_MALLOC(BlockDepl,(nb+2))
+ - + - -
+ - + ]
1816 [ - + + - : 136 : ABI_MALLOC(BlockType,(nb+2))
- + - + ]
1817 : 68 : BlockLength(1)=1;BlockDepl(1)=0;BlockType(1)=MPI_LB
1818 : 68 : jj=2
1819 [ + + ]: 2388 : do ii=1,nband_block
1820 [ + + ]: 6960 : BlockType(jj:jj+1) =wff%marker_mpi_type
1821 [ + + ]: 6960 : BlockLength(jj:jj+1)=1
1822 : 2320 : BlockDepl(jj )=(ii-1)*totsize1bandByte
1823 : 2320 : BlockDepl(jj+1)= ii *totsize1bandByte-wff%nbOct_recMarker
1824 : 2388 : jj=jj+2
1825 : : end do
1826 : 68 : BlockLength(nb+2)=1;BlockDepl(nb+2)=nband_block*totsize1bandByte;BlockType(nb+2)=MPI_UB
1827 : 68 : call xmpio_type_struct(nb+2,BlockLength,BlockDepl,BlockType,filetype,ierr)
1828 : 68 : call MPI_TYPE_COMMIT(filetype,ierr)
1829 : 68 : call MPI_FILE_SET_VIEW(wfftempo,offset,MPI_BYTE,filetype,"native",MPI_INFO_NULL,ierr)
1830 : 68 : ABI_FREE(BlockLength)
1831 : 68 : ABI_FREE(BlockDepl)
1832 : 68 : ABI_FREE(BlockType)
1833 : :
1834 : : ! Read/Write all markers (depend on Fortran marker MPI type)
1835 [ + + ]: 68 : if (wff%me_mpiio==0) then
1836 : 19 : jerr=0;delim_record=totsize1bandByte-2*wff%nbOct_recMarker
1837 [ + - ]: 19 : if (wff%nbOct_recMarker==4) then
1838 [ - + + - : 57 : ABI_MALLOC(bufdelim4,(nb))
+ - + - -
+ - + ]
1839 [ + + + + ]: 979 : if (rdwr==2) bufdelim4(:)=delim_record
1840 [ + + ]: 19 : if (rdwr==1) then
1841 : 4 : call MPI_FILE_READ (wfftempo,bufdelim4,2*nband_block,wff%marker_mpi_type,MPI_STATUS_IGNORE,ierr)
1842 [ + + + - : 404 : if (any(bufdelim4(:)/=delim_record)) jerr=1
+ - ]
1843 : : else
1844 : 15 : call MPI_FILE_WRITE(wfftempo,bufdelim4,2*nband_block,wff%marker_mpi_type,MPI_STATUS_IGNORE,ierr)
1845 : : end if
1846 [ - + ]: 19 : ABI_FREE(bufdelim4)
1847 [ # # ]: 0 : else if (wff%nbOct_recMarker==8) then
1848 [ # # # # : 0 : ABI_MALLOC(bufdelim8,(nb))
# # # # #
# # # ]
1849 [ # # # # ]: 0 : if (rdwr==2) bufdelim8(:)=delim_record
1850 [ # # ]: 0 : if (rdwr==1) then
1851 : 0 : call MPI_FILE_READ (wfftempo,bufdelim8,2*nband_block,wff%marker_mpi_type,MPI_STATUS_IGNORE,ierr)
1852 [ # # # # : 0 : if (any(bufdelim8(:)/=delim_record)) jerr=1
# # ]
1853 : : else
1854 : 0 : call MPI_FILE_WRITE(wfftempo,bufdelim8,2*nband_block,wff%marker_mpi_type,MPI_STATUS_IGNORE,ierr)
1855 : : end if
1856 [ # # ]: 0 : ABI_FREE(bufdelim8)
1857 : : #if defined HAVE_FC_INT_QUAD
1858 [ # # ]: 0 : else if (wff%nbOct_recMarker==16) then
1859 [ # # # # : 0 : ABI_MALLOC(bufdelim16,(nb))
# # # # #
# # # ]
1860 [ # # # # ]: 0 : if (rdwr==2) bufdelim16(:)=delim_record
1861 [ # # ]: 0 : if (rdwr==1) then
1862 : 0 : call MPI_FILE_READ (wfftempo,bufdelim16,2*nband_block,wff%marker_mpi_type,MPI_STATUS_IGNORE,ierr)
1863 [ # # # # : 0 : if (any(bufdelim16(:)/=delim_record)) jerr=1
# # ]
1864 : : else
1865 : 0 : call MPI_FILE_WRITE(wfftempo,bufdelim16,2*nband_block,wff%marker_mpi_type,MPI_STATUS_IGNORE,ierr)
1866 : : end if
1867 [ # # ]: 0 : ABI_FREE(bufdelim16)
1868 : : #endif
1869 [ # # ]: 0 : else if (wff%nbOct_recMarker==2) then
1870 [ # # # # : 0 : ABI_MALLOC(bufdelim2,(nb))
# # # # #
# ]
1871 [ # # # # ]: 0 : if (rdwr==2) bufdelim2(:)=delim_record
1872 [ # # ]: 0 : if (rdwr==1) then
1873 : 0 : call MPI_FILE_READ (wfftempo,bufdelim2,2*nband_block,wff%marker_mpi_type,MPI_STATUS_IGNORE,ierr)
1874 [ # # # # : 0 : if (any(bufdelim2(:)/=delim_record)) jerr=1
# # ]
1875 : : else
1876 : 0 : call MPI_FILE_WRITE(wfftempo,bufdelim2,2*nband_block,wff%marker_mpi_type,MPI_STATUS_IGNORE,ierr)
1877 : : end if
1878 [ # # ]: 0 : ABI_FREE(bufdelim2)
1879 : : end if
1880 [ + + - + ]: 19 : if (rdwr==1.and.jerr==1) then
1881 : 0 : write(unit=msg,fmt='(2a)') 'Error when reading record markers of file ',trim(wff%fname)
1882 : 0 : ABI_ERROR(msg)
1883 : : end if
1884 : : end if ! me_mpiio=0
1885 : :
1886 : : ! Free memory
1887 : 68 : call MPI_TYPE_FREE(filetype,ierr)
1888 : :
1889 : : end if ! rdwr
1890 : :
1891 : : ! -----------------------------------------
1892 : : ! End loop on blocks of bands
1893 : : ! -----------------------------------------
1894 [ + - ]: 68 : if (ibandmax>=nband_disk) exit
1895 : 68 : ibandmin=ibandmax+1
1896 : : end do
1897 : :
1898 : : !-----------------------------------------
1899 : : !End statements
1900 : : !-----------------------------------------
1901 : : !Close file
1902 : 68 : call MPI_FILE_CLOSE(wfftempo,ierr)
1903 : :
1904 : : !Update offset
1905 : 68 : wff%offwff=wff%offwff+totsize1bandByte*nband_disk
1906 : : #endif
1907 : :
1908 : : #if !defined HAVE_MPI_IO
1909 : : !Dummy check to avoid warning from compilers.
1910 : : ABI_UNUSED((/wff%iomode,rdwr,size(cg),mcg,icg,nband_disk,npwso,depl_mpi_to_seq(1),npwsotot/))
1911 : : #endif
1912 : :
1913 [ - + ]: 68 : end subroutine WffReadWrite_mpio
1914 : : !!***
1915 : :
1916 : : !----------------------------------------------------------------------
1917 : :
1918 : : !!****f* m_wffile/WffWriteDataRec_int2d
1919 : : !! NAME
1920 : : !! WffWriteDataRec_int2d
1921 : : !!
1922 : : !! FUNCTION
1923 : : !! Subroutine to write data in one record of a wavefunction file
1924 : : !! Handles integer 2D arrays
1925 : : !!
1926 : : !! INPUTS
1927 : : !! intarray=array of integer numbers
1928 : : !! n1,n2=sizes of the integer array to be written
1929 : : !! wff= structured info about the wavefunction file
1930 : : !!
1931 : : !! OUTPUT
1932 : : !! ierr=error code
1933 : : !!
1934 : : !! SIDE EFFECTS
1935 : : !!
1936 : : !! SOURCE
1937 : :
1938 : 0 : subroutine WffWriteDataRec_int2d(intarray,ierr,n1,n2,wff)
1939 : :
1940 : : !Arguments ------------------------------------
1941 : : type(wffile_type),intent(inout) :: wff
1942 : : integer,intent(in) :: n1,n2
1943 : : integer,intent(out) :: ierr
1944 : : integer,intent(in) :: intarray(n1,n2)
1945 : :
1946 : : !Local variables-------------------------------
1947 : : character(len=500) :: msg
1948 : :
1949 : : ! *************************************************************************
1950 : :
1951 : 0 : ierr=0
1952 [ # # # # : 0 : if (wff%iomode==IO_MODE_FORTRAN.or.(wff%iomode==IO_MODE_FORTRAN_MASTER.and.wff%master==wff%me)) then
# # ]
1953 : 0 : write(wff%unwff,iostat=ierr) intarray(1:n1,1:n2)
1954 : :
1955 [ # # ]: 0 : else if(wff%iomode==IO_MODE_MPI)then
1956 : : #if defined HAVE_MPI_IO
1957 : 0 : call xderiveWRecInit(wff,ierr)
1958 : 0 : call xderiveWrite(wff,intarray,n1,n2,MPI_COMM_SELF,ierr)
1959 : 0 : call xderiveWRecEnd(wff,ierr)
1960 : : #endif
1961 : : else
1962 : 0 : write(msg,'(a,i0,a)')' The value of wff%iomode=',wff%iomode,' is not allowed.'
1963 : 0 : ABI_WARNING(msg)
1964 : : end if
1965 : :
1966 : 0 : end subroutine WffWriteDataRec_int2d
1967 : : !!***
1968 : :
1969 : : !----------------------------------------------------------------------
1970 : :
1971 : :
1972 : : !!****f* m_wffile/WffWriteDataRec_dp1d
1973 : : !! NAME
1974 : : !! WffWriteDataRec_dp1d
1975 : : !!
1976 : : !! FUNCTION
1977 : : !! Subroutine to write data in one record of a wavefunction file
1978 : : !! Handles double precision 1D arrays
1979 : : !!
1980 : : !! INPUTS
1981 : : !! dparray=array of double precision numbers
1982 : : !! ndp=size of the double precision array to be written
1983 : : !! wff= structured info about the wavefunction file
1984 : : !!
1985 : : !! OUTPUT
1986 : : !! ierr=error code
1987 : : !!
1988 : : !! SIDE EFFECTS
1989 : : !!
1990 : : !! SOURCE
1991 : :
1992 : 0 : subroutine WffWriteDataRec_dp1d(dparray,ierr,ndp,wff)
1993 : :
1994 : : !Arguments ------------------------------------
1995 : : type(wffile_type),intent(inout) :: wff
1996 : : integer,intent(in) :: ndp
1997 : : integer,intent(out) :: ierr
1998 : : real(dp),intent(in) :: dparray(ndp)
1999 : :
2000 : : !Local variables-------------------------------
2001 : : character(len=500) :: msg
2002 : :
2003 : : ! *************************************************************************
2004 : :
2005 : 0 : ierr=0
2006 [ # # # # : 0 : if (wff%iomode==IO_MODE_FORTRAN.or.(wff%iomode==IO_MODE_FORTRAN_MASTER.and.wff%master==wff%me)) then
# # ]
2007 : 0 : write(wff%unwff,iostat=ierr) dparray(1:ndp)
2008 : :
2009 [ # # ]: 0 : else if(wff%iomode==IO_MODE_MPI)then
2010 : : #if defined HAVE_MPI_IO
2011 : 0 : call xderiveWRecInit(wff,ierr)
2012 : 0 : call xderiveWrite(wff,dparray,ndp,MPI_COMM_SELF,ierr)
2013 : 0 : call xderiveWRecEnd(wff,ierr)
2014 : : #endif
2015 : : else
2016 : 0 : write(msg,'(a,i0,a)')' The value of wff%iomode=',wff%iomode,' is not allowed.'
2017 : 0 : ABI_WARNING(msg)
2018 : : end if
2019 : :
2020 : 0 : end subroutine WffWriteDataRec_dp1d
2021 : : !!***
2022 : :
2023 : : !----------------------------------------------------------------------
2024 : :
2025 : :
2026 : : !!****f* m_wffile/WffWriteDataRec_dp2d
2027 : : !! NAME
2028 : : !! WffWriteDataRec_dp2d
2029 : : !!
2030 : : !! FUNCTION
2031 : : !! Subroutine to write data in one record of a wavefunction file
2032 : : !! Handles double precision 2D arrays
2033 : : !!
2034 : : !! INPUTS
2035 : : !! dparray=array of double precision numbers
2036 : : !! n1,n2=sizes of the double precision array to be written
2037 : : !! wff= structured info about the wavefunction file
2038 : : !!
2039 : : !! OUTPUT
2040 : : !! ierr=error code
2041 : : !!
2042 : : !! SIDE EFFECTS
2043 : : !!
2044 : : !! SOURCE
2045 : :
2046 : :
2047 : 0 : subroutine WffWriteDataRec_dp2d(dparray,ierr,n1,n2,wff)
2048 : :
2049 : : !Arguments ------------------------------------
2050 : : type(wffile_type),intent(inout) :: wff
2051 : : integer,intent(in) :: n1,n2
2052 : : integer,intent(out) :: ierr
2053 : : real(dp),intent(in) :: dparray(n1,n2)
2054 : :
2055 : : !Local variables-------------------------------
2056 : : character(len=500) :: msg
2057 : :
2058 : : ! *************************************************************************
2059 : :
2060 : 0 : ierr=0
2061 [ # # # # : 0 : if (wff%iomode==IO_MODE_FORTRAN.or.(wff%iomode==IO_MODE_FORTRAN_MASTER.and.wff%master==wff%me)) then
# # ]
2062 : 0 : write(wff%unwff,iostat=ierr) dparray(1:n1,1:n2)
2063 : :
2064 [ # # ]: 0 : else if(wff%iomode==IO_MODE_MPI)then
2065 : : #if defined HAVE_MPI_IO
2066 : 0 : call xderiveWRecInit(wff,ierr)
2067 : 0 : call xderiveWrite(wff,dparray,n1,n2,MPI_COMM_SELF,ierr)
2068 : 0 : call xderiveWRecEnd(wff,ierr)
2069 : : #endif
2070 : : else
2071 : 0 : write(msg,'(a,i0,a)')' The value of wff%iomode=',wff%iomode,' is not allowed.'
2072 : 0 : ABI_WARNING(msg)
2073 : : end if
2074 : :
2075 : 0 : end subroutine WffWriteDataRec_dp2d
2076 : : !!***
2077 : :
2078 : : !----------------------------------------------------------------------
2079 : :
2080 : :
2081 : : !!****f* m_wffile/WffWriteNpwRec
2082 : : !! NAME
2083 : : !! WffWriteNpwRec
2084 : : !!
2085 : : !! FUNCTION
2086 : : !! This subroutine writes the npw record of a wavefunction file
2087 : : !!
2088 : : !! INPUTS
2089 : : !! wff= structured info about the wavefunction file
2090 : : !! nband_disk=number of bands
2091 : : !! npw=number of plane waves
2092 : : !! nspinor=number of spinorial components of the wavefunctions
2093 : : !! opt_paral=(optional argument, default=1, only used for MPI-IO)
2094 : : !! 1: all procs in the communicator write the data
2095 : : !! 2: only master in the communicator writes the data
2096 : : !!
2097 : : !! OUTPUT
2098 : : !! ierr=error code
2099 : : !!
2100 : : !! SIDE EFFECTS
2101 : : !!
2102 : : !! SOURCE
2103 : :
2104 : :
2105 : 416 : subroutine WffWriteNpwRec(ierr,nband_disk,npw,nspinor,wff,&
2106 : : & opt_paral) ! optional argument
2107 : :
2108 : : !Arguments ------------------------------------
2109 : : type(wffile_type),intent(inout) :: wff
2110 : : integer,intent(in) :: nband_disk,npw,nspinor
2111 : : integer,intent(in),optional :: opt_paral
2112 : : integer,intent(out) :: ierr
2113 : :
2114 : : !Local variables-------------------------------
2115 : : integer :: opt_paral_
2116 : : character(len=500) :: msg
2117 : : #if defined HAVE_MPI_IO
2118 : : integer :: me
2119 : : integer(kind=MPI_OFFSET_KIND) :: off(1)
2120 : : #endif
2121 : :
2122 : : ! *************************************************************************
2123 : :
2124 : 416 : ierr=0
2125 [ + - ]: 416 : opt_paral_=1;if (present(opt_paral)) opt_paral_=opt_paral
2126 : :
2127 [ + - + + : 416 : if (wff%iomode==IO_MODE_FORTRAN.or.(wff%iomode ==IO_MODE_FORTRAN_MASTER.and.wff%master==wff%me)) then
+ - ]
2128 : 364 : write(wff%unwff,iostat=ierr) npw,nspinor,nband_disk
2129 : :
2130 [ + - ]: 52 : else if(wff%iomode==IO_MODE_MPI)then
2131 : : #if defined HAVE_MPI_IO
2132 [ + - ]: 52 : me=-1;if (opt_paral_==2) me=wff%me_mpiio
2133 [ + - + + ]: 52 : if ((me==-1.and.opt_paral_==1).or.(me==0.and.opt_paral_==2)) then
2134 : 15 : call xderiveWRecInit(wff,ierr)
2135 : 15 : call xderiveWrite(wff,npw,ierr)
2136 : 15 : call xderiveWrite(wff,nspinor,ierr)
2137 : 15 : call xderiveWrite(wff,nband_disk,ierr)
2138 : 15 : call xderiveWRecEnd(wff,ierr)
2139 : : end if
2140 [ + - + - ]: 52 : if (opt_paral_==2.and.wff%spaceComm_mpiio/=MPI_COMM_SELF) then
2141 : 52 : call xmpi_barrier(wff%spaceComm_mpiio)
2142 : 52 : off(1)=wff%offwff
2143 : 52 : call MPI_BCAST(off,1,wff%offset_mpi_type,0,wff%spaceComm_mpiio,ierr)
2144 : 52 : wff%offwff=off(1)
2145 : : end if
2146 : : #endif
2147 : : else
2148 : 0 : write(msg,'(a,i0,a)')' The value of wff%iomode=',wff%iomode,' is not allowed.'
2149 : 0 : ABI_WARNING(msg)
2150 : : end if
2151 : :
2152 : 416 : end subroutine WffWriteNpwRec
2153 : : !!***
2154 : :
2155 : : !!****f* m_wffile/xderiveRead_int
2156 : : !! NAME
2157 : : !! xderiveRead_int
2158 : : !!
2159 : : !! FUNCTION
2160 : : !! Generic routine to read/write wf files with MPI I/O.
2161 : : !! Target: integer scalar.
2162 : : !!
2163 : : !! INPUTS
2164 : : !! (none)
2165 : : !!
2166 : : !! OUTPUT
2167 : : !! xval= data buffer
2168 : : !! ierr= exit status, a non-zero value meaning there is an error
2169 : : !!
2170 : : !! SIDE EFFECTS
2171 : : !! wff= structured info for reading/writing the wavefunctions
2172 : : !!
2173 : : !! SOURCE
2174 : :
2175 : 48 : subroutine xderiveRead_int(wff,xval,ierr)
2176 : :
2177 : : !Arguments ------------------------------------
2178 : : type(wffile_type),intent(inout) :: wff
2179 : : integer,intent(out) :: xval
2180 : : integer,intent(out) :: ierr
2181 : :
2182 : : !Local variables-------------------------------
2183 : : #if defined HAVE_MPI_IO
2184 : : integer :: arr_xval(1),statux(MPI_STATUS_SIZE)
2185 : : #endif
2186 : : character(len=500) :: msg
2187 : :
2188 : : ! *********************************************************************
2189 : :
2190 : 48 : xval=0; ierr=0
2191 : :
2192 : : #if defined HAVE_MPI_IO
2193 : 48 : call MPI_FILE_READ_AT(wff%fhwff,wff%offwff,arr_xval,1,MPI_INTEGER,statux,ierr)
2194 : 48 : xval=arr_xval(1)
2195 : 48 : wff%offwff = wff%offwff + wff%nbOct_int
2196 : 48 : RETURN
2197 : : #endif
2198 : :
2199 : : ABI_UNUSED(wff%me)
2200 : :
2201 : : write(msg,'(a,i0,a)')' The value of wff%iomode=',wff%iomode,' is not allowed.'
2202 : : ABI_WARNING(msg)
2203 : :
2204 : : end subroutine xderiveRead_int
2205 : : !!***
2206 : :
2207 : : !----------------------------------------------------------------------
2208 : :
2209 : :
2210 : : !!****f* m_wffile/xderiveRead_int1d
2211 : : !! NAME
2212 : : !! xderiveRead_int1d
2213 : : !!
2214 : : !! FUNCTION
2215 : : !! Generic routine to read/write wf files with MPI I/O.
2216 : : !! Target: one-dimensional integer arrays.
2217 : : !!
2218 : : !! INPUTS
2219 : : !! n1= first dimension of the array
2220 : : !! spaceComm= MPI communicator
2221 : : !!
2222 : : !! OUTPUT
2223 : : !! xval= data buffer array
2224 : : !! ierr= exit status, a non-zero value meaning there is an error
2225 : : !!
2226 : : !! SIDE EFFECTS
2227 : : !! wff= structured info for reading/writing the wavefunctions
2228 : : !!
2229 : : !! SOURCE
2230 : :
2231 [ # # ]: 0 : subroutine xderiveRead_int1d(wff,xval,n1,spaceComm,ierr)
2232 : :
2233 : : !Arguments ------------------------------------
2234 : : type(wffile_type),intent(inout) :: wff
2235 : : integer,intent(out) :: xval(:)
2236 : : integer,intent(in) :: n1,spaceComm
2237 : : integer,intent(out) :: ierr
2238 : :
2239 : : !Local variables-------------------------------
2240 : : #if defined HAVE_MPI_IO
2241 : : integer(kind=MPI_OFFSET_KIND) :: delim_record,nboct,dispoct(1),posit,totoct
2242 : : integer :: statux(MPI_STATUS_SIZE)
2243 : : #endif
2244 : : character(len=500) :: msg
2245 : :
2246 : : ! *********************************************************************
2247 : :
2248 [ # # ]: 0 : xval(:)=0 ; ierr=0 ! Initialization, for the compiler
2249 : : if(.false.)write(std_out,*)wff%me,n1,spaceComm
2250 : :
2251 : : #if defined HAVE_MPI_IO
2252 : 0 : nboct = wff%nbOct_int * n1
2253 : 0 : posit = wff%offwff
2254 : 0 : delim_record = posit - wff%off_recs + wff%lght_recs - wff%nbOct_recMarker
2255 : :
2256 [ # # ]: 0 : if (delim_record >= nboct) then
2257 : : ! Compute offset for local part
2258 : : ! dispoct = sum (nboct, rank=0..me)
2259 [ # # ]: 0 : if (spaceComm/=MPI_COMM_SELF) then
2260 [ # # ]: 0 : call MPI_SCAN([nboct],dispoct,1,wff%offset_mpi_type,MPI_SUM,spaceComm,ierr)
2261 : 0 : posit = posit + dispoct(1) - nboct
2262 : : end if
2263 [ # # ]: 0 : call MPI_FILE_READ_AT(wff%fhwff,posit,xval,n1,MPI_INTEGER,statux,ierr)
2264 : :
2265 : : ! get the total number of bits wrote by processors
2266 [ # # ]: 0 : if (spaceComm/=MPI_COMM_SELF) then
2267 : 0 : call xmpi_max(dispoct(1),totoct,spaceComm,ierr)
2268 : : !call MPI_ALLREDUCE(dispoct,totoct,1,wff%offset_mpi_type,MPI_MAX,spaceComm,ierr)
2269 : : else
2270 : 0 : totoct=nboct
2271 : : end if
2272 : : else
2273 : 0 : ierr = 1
2274 : 0 : nboct = 0
2275 : 0 : totoct = 0
2276 : : end if
2277 : :
2278 : : !new offset
2279 : 0 : wff%offwff = wff%offwff + totoct
2280 : 0 : return
2281 : : #endif
2282 : :
2283 : : write(msg,'(a,i0,a)')' The value of wff%iomode=',wff%iomode,' is not allowed.'
2284 : : ABI_WARNING(msg)
2285 : :
2286 : : end subroutine xderiveRead_int1d
2287 : : !!***
2288 : :
2289 : : !----------------------------------------------------------------------
2290 : :
2291 : :
2292 : : !!****f* m_wffile/xderiveRead_int2d
2293 : : !! NAME
2294 : : !! xderiveRead_int2d
2295 : : !!
2296 : : !! FUNCTION
2297 : : !! Generic routine to read/write wf files with MPI I/O.
2298 : : !! Target: two-dimensional integer arrays.
2299 : : !!
2300 : : !! INPUTS
2301 : : !! n1= first dimension of the array
2302 : : !! n2= second dimension of the array
2303 : : !! spaceComm= MPI communicator
2304 : : !!
2305 : : !! OUTPUT
2306 : : !! xval= data buffer array
2307 : : !! ierr= exit status, a non-zero value meaning there is an error
2308 : : !!
2309 : : !! SIDE EFFECTS
2310 : : !! wff= structured info for reading/writing the wavefunctions
2311 : : !!
2312 : : !! SOURCE
2313 : :
2314 [ # # ]: 0 : subroutine xderiveRead_int2d(wff,xval,n1,n2,spaceComm,ierr)
2315 : :
2316 : : !Arguments ------------------------------------
2317 : : type(wffile_type),intent(inout) :: wff
2318 : : integer,intent(out) :: xval(:,:)
2319 : : integer,intent(in) :: n1,n2,spaceComm
2320 : : integer,intent(out) :: ierr
2321 : :
2322 : : !Local variables-------------------------------
2323 : : #if defined HAVE_MPI_IO
2324 : : integer(kind=MPI_OFFSET_KIND) :: delim_record,nboct,dispoct(1),posit,totoct
2325 : : integer :: statux(MPI_STATUS_SIZE)
2326 : : #endif
2327 : : character(len=500) :: msg
2328 : :
2329 : : ! *********************************************************************
2330 : :
2331 [ # # # # ]: 0 : xval(:,:)=0 ; ierr=0 ! Initialization, for the compiler
2332 : : if(.false.)write(std_out,*)wff%me,n1,n2,spaceComm
2333 : :
2334 : : #if defined HAVE_MPI_IO
2335 : 0 : nboct = wff%nbOct_int * n1 * n2
2336 : 0 : posit = wff%offwff
2337 : 0 : delim_record = posit - wff%off_recs + wff%lght_recs - wff%nbOct_recMarker
2338 : :
2339 [ # # ]: 0 : if (delim_record >= nboct) then
2340 : : ! Compute offset for local part
2341 : : ! dispoct = sum (nboct, rank=0..me)
2342 [ # # ]: 0 : if (spaceComm/=MPI_COMM_SELF) then
2343 [ # # ]: 0 : call MPI_SCAN([nboct],dispoct,1,wff%offset_mpi_type,MPI_SUM,spaceComm,ierr)
2344 : 0 : posit = posit + dispoct(1) - nboct
2345 : : end if
2346 [ # # ]: 0 : call MPI_FILE_READ_AT(wff%fhwff,posit,xval,n1*n2,MPI_INTEGER,statux,ierr)
2347 : :
2348 : : ! get the total number of bits wrote by processors
2349 [ # # ]: 0 : if (spaceComm/=MPI_COMM_SELF) then
2350 : 0 : call xmpi_max(dispoct(1),totoct,spaceComm,ierr)
2351 : : !call MPI_ALLREDUCE(dispoct,totoct,1,wff%offset_mpi_type,MPI_MAX,spaceComm,ierr)
2352 : : else
2353 : 0 : totoct=nboct
2354 : : end if
2355 : : else
2356 : 0 : ierr = 1
2357 : 0 : nboct = 0
2358 : 0 : totoct = 0
2359 : : end if
2360 : :
2361 : : !new offset
2362 : 0 : wff%offwff=wff%offwff + totoct
2363 : 0 : return
2364 : : #endif
2365 : :
2366 : : write(msg,'(a,i0,a)')' The value of wff%iomode=',wff%iomode,' is not allowed.'
2367 : : ABI_WARNING(msg)
2368 : :
2369 : : end subroutine xderiveRead_int2d
2370 : : !!***
2371 : :
2372 : : !----------------------------------------------------------------------
2373 : :
2374 : :
2375 : : !!****f* m_wffile/xderiveRead_dp
2376 : : !! NAME
2377 : : !! xderiveRead_dp
2378 : : !!
2379 : : !! FUNCTION
2380 : : !! Generic routine to read/write wf files with MPI I/O.
2381 : : !! Target: double precision scalar.
2382 : : !!
2383 : : !! INPUTS
2384 : : !! (none)
2385 : : !!
2386 : : !! OUTPUT
2387 : : !! xval= data buffer
2388 : : !! ierr= exit status, a non-zero value meaning there is an error
2389 : : !!
2390 : : !! SIDE EFFECTS
2391 : : !! wff= structured info for reading/writing the wavefunctions
2392 : : !!
2393 : : !! SOURCE
2394 : :
2395 : 0 : subroutine xderiveRead_dp(wff,xval,ierr)
2396 : :
2397 : : !Arguments ------------------------------------
2398 : : type(wffile_type),intent(inout) :: wff
2399 : : integer,intent(out) :: ierr
2400 : : real(dp),intent(out) :: xval
2401 : :
2402 : : !Local variables-------------------------------
2403 : : #if defined HAVE_MPI_IO
2404 : : integer :: statux(MPI_STATUS_SIZE)
2405 : : real(dp) :: arr_xval(1)
2406 : : #endif
2407 : : character(len=500) :: msg
2408 : :
2409 : : ! *********************************************************************
2410 : :
2411 : 0 : xval=zero ; ierr=0
2412 : : if(.false.)write(std_out,*)wff%me
2413 : : #if defined HAVE_MPI_IO
2414 : 0 : call MPI_FILE_READ_AT(wff%fhwff,wff%offwff,arr_xval,1,MPI_DOUBLE_PRECISION,statux,ierr)
2415 : 0 : xval=arr_xval(1)
2416 : 0 : wff%offwff = wff%offwff + wff%nbOct_dp
2417 : 0 : return
2418 : : #endif
2419 : :
2420 : : write(msg,'(a,i0,a)')' The value of wff%iomode=',wff%iomode,' is not allowed.'
2421 : : ABI_WARNING(msg)
2422 : :
2423 : : end subroutine xderiveRead_dp
2424 : : !!***
2425 : :
2426 : : !----------------------------------------------------------------------
2427 : :
2428 : :
2429 : : !!****f* ABINIT/xderiveRead_dp1d
2430 : : !! NAME
2431 : : !! xderiveRead_dp1d
2432 : : !!
2433 : : !! FUNCTION
2434 : : !! Generic routine to read/write wf files with MPI I/O.
2435 : : !! Target: one-dimensional double precision arrays.
2436 : : !!
2437 : : !! INPUTS
2438 : : !! n1= first dimension of the array
2439 : : !! spaceComm= MPI communicator
2440 : : !!
2441 : : !! OUTPUT
2442 : : !! ierr= exit status, a non-zero value meaning there is an error
2443 : : !! xval= data buffer array
2444 : : !!
2445 : : !! SIDE EFFECTS
2446 : : !! wff= structured info for reading/writing the wavefunctions
2447 : : !!
2448 : : !! SOURCE
2449 : :
2450 [ - + ]: 16 : subroutine xderiveRead_dp1d(wff,xval,n1,spaceComm,ierr)
2451 : :
2452 : : !Arguments ------------------------------------
2453 : : type(wffile_type),intent(inout) :: wff
2454 : : integer,intent(in) :: n1,spaceComm
2455 : : integer,intent(out) :: ierr
2456 : : real(dp),intent(out) :: xval(:)
2457 : :
2458 : : !Local variables-------------------------------
2459 : : #if defined HAVE_MPI_IO
2460 : : integer(kind=MPI_OFFSET_KIND) :: delim_record,nboct,dispoct(1),posit,totoct
2461 : : integer :: statux(MPI_STATUS_SIZE)
2462 : : #endif
2463 : : character(len=500) :: msg
2464 : :
2465 : : !*********************************************************************
2466 : :
2467 [ + + ]: 816 : xval(:)=zero ; ierr=0 ! Initialization, for the compiler
2468 : : if(.false.)write(std_out,*)wff%me,n1,spaceComm
2469 : :
2470 : : #if defined HAVE_MPI_IO
2471 : 16 : nboct = wff%nbOct_dp * n1
2472 : 16 : posit = wff%offwff
2473 : 16 : delim_record = posit - wff%off_recs + wff%lght_recs - wff%nbOct_recMarker
2474 : :
2475 [ + - ]: 16 : if (delim_record >= nboct) then
2476 : : ! Compute offset for local part
2477 : : ! dispoct = sum (nboct, rank=0..me)
2478 [ - + ]: 16 : if (spaceComm/=MPI_COMM_SELF) then
2479 [ # # ]: 0 : call MPI_SCAN([nboct],dispoct,1,wff%offset_mpi_type,MPI_SUM,spaceComm,ierr)
2480 : 0 : posit = posit + dispoct(1) - nboct
2481 : : end if
2482 : :
2483 [ - + ]: 16 : call MPI_FILE_READ_AT(wff%fhwff,posit,xval,n1,MPI_DOUBLE_PRECISION,statux,ierr)
2484 : :
2485 : : ! get the total number of bits wrote by processors
2486 [ - + ]: 16 : if (spaceComm/=MPI_COMM_SELF) then
2487 : 0 : call xmpi_max(dispoct(1),totoct,spaceComm,ierr)
2488 : : !call MPI_ALLREDUCE(dispoct,totoct,1,wff%offset_mpi_type,MPI_MAX,spaceComm,ierr)
2489 : : else
2490 : 16 : totoct=nboct
2491 : : end if
2492 : : else
2493 : 0 : ierr = 1
2494 : 0 : nboct = 0
2495 : 0 : totoct = 0
2496 : : end if
2497 : :
2498 : : !new offset
2499 : 16 : wff%offwff=wff%offwff + totoct
2500 : 16 : return
2501 : : #endif
2502 : :
2503 : : write(msg,'(a,i0,a)')' The value of wff%iomode=',wff%iomode,' is not allowed.'
2504 : : ABI_WARNING(msg)
2505 : :
2506 : : end subroutine xderiveRead_dp1d
2507 : : !!***
2508 : :
2509 : : !----------------------------------------------------------------------
2510 : :
2511 : : !!****f* m_wffile/xderiveRead_dp2d
2512 : : !! NAME
2513 : : !! xderiveRead_dp2d
2514 : : !!
2515 : : !! FUNCTION
2516 : : !! Generic routine to read/write wf files with MPI I/O.
2517 : : !! Target: double precision two-dimensional arrays.
2518 : : !!
2519 : : !! INPUTS
2520 : : !! n1= first dimension of the array
2521 : : !! n2= second dimension of the array
2522 : : !! spaceComm= MPI communicator
2523 : : !!
2524 : : !! OUTPUT
2525 : : !! ierr= exit status, a non-zero value meaning there is an error
2526 : : !! xval= data buffer array
2527 : : !!
2528 : : !! SIDE EFFECTS
2529 : : !! wff= structured info for reading/writing the wavefunctions
2530 : : !!
2531 : : !! SOURCE
2532 : :
2533 [ # # ]: 0 : subroutine xderiveRead_dp2d(wff,xval,n1,n2,spaceComm,ierr)
2534 : :
2535 : : !Arguments ------------------------------------
2536 : : type(wffile_type),intent(inout) :: wff
2537 : : integer,intent(in) :: n1,n2,spaceComm
2538 : : integer,intent(out) :: ierr
2539 : : real(dp),intent(out) :: xval(:,:)
2540 : :
2541 : : !Local variables-------------------------------
2542 : : #if defined HAVE_MPI_IO
2543 : : integer(kind=MPI_OFFSET_KIND) :: delim_record,nboct,dispoct(1),posit,totoct
2544 : : integer :: statux(MPI_STATUS_SIZE)
2545 : : #endif
2546 : : character(len=500) :: msg
2547 : :
2548 : : ! *********************************************************************
2549 : :
2550 [ # # # # ]: 0 : xval(:,:)=zero ; ierr=0 ! Initialization, for the compiler
2551 : : if(.false.)write(std_out,*)wff%me,n1,n2,spaceComm
2552 : :
2553 : : #if defined HAVE_MPI_IO
2554 : 0 : nboct = wff%nbOct_dp * n1 *n2
2555 : 0 : posit = wff%offwff
2556 : 0 : delim_record = posit - wff%off_recs + wff%lght_recs - wff%nbOct_recMarker
2557 : :
2558 [ # # ]: 0 : if (delim_record >= nboct) then
2559 : : ! Compute offset for local part
2560 : : ! dispoct = sum (nboct, rank=0..me)
2561 [ # # ]: 0 : if (spaceComm/=MPI_COMM_SELF) then
2562 [ # # ]: 0 : call MPI_SCAN([nboct],dispoct,1,wff%offset_mpi_type,MPI_SUM,spaceComm,ierr)
2563 : 0 : posit = posit + dispoct(1) - nboct
2564 : : end if
2565 [ # # ]: 0 : call MPI_FILE_READ_AT(wff%fhwff,posit,xval,n1*n2,MPI_DOUBLE_PRECISION,statux,ierr)
2566 : :
2567 : : ! get the total number of bits wrote by processors
2568 [ # # ]: 0 : if (spaceComm/=MPI_COMM_SELF) then
2569 : 0 : call xmpi_max(dispoct(1),totoct,spaceComm,ierr)
2570 : : !call MPI_ALLREDUCE(dispoct,totoct,1,wff%offset_mpi_type,MPI_MAX,spaceComm,ierr)
2571 : : else
2572 : 0 : totoct=nboct
2573 : : end if
2574 : : else
2575 : 0 : ierr = 1
2576 : 0 : nboct = 0
2577 : 0 : totoct = 0
2578 : : end if
2579 : :
2580 : : !new offset
2581 : 0 : wff%offwff=wff%offwff + totoct
2582 : 0 : return
2583 : : #endif
2584 : :
2585 : : write(msg,'(a,i0,a)')' The value of wff%iomode=',wff%iomode,' is not allowed.'
2586 : : ABI_WARNING(msg)
2587 : :
2588 : : end subroutine xderiveRead_dp2d
2589 : : !!***
2590 : :
2591 : : !----------------------------------------------------------------------
2592 : :
2593 : :
2594 : : !!****f* m_wffile/xderiveRead_int2d_displ
2595 : : !! NAME
2596 : : !! xderiveRead_int2d_displ
2597 : : !!
2598 : : !! FUNCTION
2599 : : !! Generic routine to read/write wf files with MPI I/O.
2600 : : !! Target: two-dimensional integer arrays.
2601 : : !!
2602 : : !! INPUTS
2603 : : !! n1= first dimension of the array
2604 : : !! n2= second dimension of the array
2605 : : !! spaceComm= MPI communicator
2606 : : !! displace= number of elements for the offset
2607 : : !!
2608 : : !! OUTPUT
2609 : : !! ierr= exit status, a non-zero value meaning there is an error
2610 : : !! xval= data buffer array
2611 : : !!
2612 : : !! SIDE EFFECTS
2613 : : !! wff= structured info for reading/writing the wavefunctions
2614 : : !!
2615 : : !! SOURCE
2616 : :
2617 [ # # # # ]: 0 : subroutine xderiveRead_int2d_displ(wff,xval,n1,n2,spaceComm,displace,ierr)
2618 : :
2619 : : !Arguments ------------------------------------
2620 : : type(wffile_type),intent(inout) :: wff
2621 : : integer,intent(in) :: n1,n2,spaceComm
2622 : : integer,intent(out) :: ierr
2623 : : integer,intent(out):: xval(:,:)
2624 : : integer,intent(in):: displace(:)
2625 : :
2626 : : !Local variables-------------------------------
2627 : : #if defined HAVE_MPI_IO
2628 : : !scalars
2629 : : integer :: filetype,i1,i2,ipos,nb,nbval,totsize,wfftempo
2630 : : !arrays
2631 : : integer :: statux(MPI_STATUS_SIZE)
2632 : 0 : integer,allocatable :: buf_val(:),length1(:),type1(:),val(:)
2633 : 0 : integer(kind=MPI_OFFSET_KIND),allocatable :: depl(:),depl1(:),depl_val(:)
2634 : : #endif
2635 : : character(len=500) :: msg
2636 : :
2637 : : ! *********************************************************************
2638 : :
2639 [ # # # # ]: 0 : xval(:,:)=0 ; ierr=0
2640 : : if(.false.)write(std_out,*)wff%me,n1,n2,spaceComm,displace
2641 : :
2642 : : #if defined HAVE_MPI_IO
2643 : 0 : nb=n1*n2
2644 : 0 : call xmpi_sum(nb,totsize,spaceComm,ierr)
2645 [ # # # # : 0 : ABI_MALLOC(depl_val,(0:totsize-1))
# # # # #
# # # ]
2646 [ # # # # : 0 : ABI_MALLOC(depl,(nb))
# # # # #
# # # ]
2647 [ # # # # : 0 : ABI_MALLOC(buf_val,(0:totsize-1))
# # # # #
# # # ]
2648 [ # # # # : 0 : ABI_MALLOC(val,(nb))
# # # # #
# # # ]
2649 : :
2650 : : !Map displacements
2651 [ # # ]: 0 : depl_val(0:totsize-1)=-1
2652 [ # # ]: 0 : do i2=1,n2
2653 [ # # ]: 0 : do i1=1,n1
2654 : 0 : ipos=(displace(i2)-1)*n1 + i1-1
2655 : 0 : depl_val(ipos)=ipos
2656 : : end do
2657 : : end do
2658 : : !To save time, the location described by array map must be in increasing order
2659 : 0 : nbval=0
2660 [ # # ]: 0 : do i1=0,totsize-1
2661 [ # # ]: 0 : if (depl_val(i1)/=-1) then
2662 : 0 : nbval=nbval+1
2663 : 0 : depl(nbval)=depl_val(i1)
2664 : : end if
2665 : : end do
2666 : :
2667 : : !Build MPI datatype for view
2668 [ # # # # : 0 : ABI_MALLOC(length1,(nbval+2))
# # # # #
# # # #
# ]
2669 [ # # # # : 0 : ABI_MALLOC(depl1,(nbval+2))
# # # # #
# # # ]
2670 [ # # # # : 0 : ABI_MALLOC(type1,(nbval+2))
# # # # ]
2671 : 0 : length1(1)=1;depl1(1)=0;type1(1)=MPI_LB
2672 [ # # ]: 0 : do i1=2,nbval+1
2673 : 0 : length1(i1) = 1
2674 : 0 : depl1(i1)= depl(i1-1)*wff%nbOct_int
2675 : 0 : type1(i1)= MPI_INTEGER
2676 : : end do
2677 : 0 : length1(nbval+2)=1;depl1(nbval+2)=totsize*wff%nbOct_int;type1(nbval+2)=MPI_UB
2678 : 0 : call xmpio_type_struct(nbval+2,length1,depl1,type1,filetype,ierr)
2679 : 0 : call MPI_TYPE_COMMIT(filetype,ierr)
2680 : 0 : ABI_FREE(length1)
2681 : 0 : ABI_FREE(depl1)
2682 : 0 : ABI_FREE(type1)
2683 : :
2684 : : !Read data (read-only: the file may not be writable)
2685 : 0 : call MPI_FILE_OPEN(spaceComm,wff%fname,MPI_MODE_RDONLY,MPI_INFO_NULL,wfftempo,ierr)
2686 : 0 : ABI_CHECK_MPI(ierr, sjoin("MPI_FILE_OPEN:", wff%fname))
2687 : 0 : call MPI_FILE_SET_VIEW(wfftempo,wff%offwff,MPI_BYTE,filetype,"native",MPI_INFO_NULL,ierr)
2688 : 0 : call MPI_FILE_READ_ALL(wfftempo,val,nbval,MPI_INTEGER,statux,ierr)
2689 : 0 : call MPI_FILE_CLOSE(wfftempo,ierr)
2690 : :
2691 : : !Retrieve xval
2692 : 0 : nbval=0
2693 [ # # ]: 0 : do i1=0,totsize-1
2694 [ # # ]: 0 : if (depl_val(i1)/=-1) then
2695 : 0 : nbval=nbval+1
2696 : 0 : buf_val(i1)=val(nbval)
2697 : : end if
2698 : : end do
2699 [ # # ]: 0 : do i2=1,n2
2700 [ # # ]: 0 : do i1=1,n1
2701 : 0 : ipos=(displace(i2)-1)*n1 + i1-1
2702 : 0 : xval(i1,i2)=buf_val(ipos)
2703 : : end do
2704 : : end do
2705 : :
2706 : : !Update offset
2707 : 0 : wff%offwff = wff%offwff + totsize*wff%nbOct_int
2708 : :
2709 : : !Free memory
2710 : 0 : call MPI_TYPE_FREE(filetype,ierr)
2711 [ # # ]: 0 : ABI_FREE(depl)
2712 [ # # ]: 0 : ABI_FREE(depl_val)
2713 [ # # ]: 0 : ABI_FREE(buf_val)
2714 [ # # ]: 0 : ABI_FREE(val)
2715 : : return
2716 : : #endif
2717 : :
2718 : : write(msg,'(a,i0,a)')' The value of wff%iomode=',wff%iomode,' is not allowed.'
2719 : : ABI_WARNING(msg)
2720 : :
2721 : :
2722 : 0 : end subroutine xderiveRead_int2d_displ
2723 : : !!***
2724 : :
2725 : : !----------------------------------------------------------------------
2726 : :
2727 : : !!****f* m_wffile/xderiveRead_dp2d_displ
2728 : : !! NAME
2729 : : !! xderiveRead_dp2d_displ
2730 : : !!
2731 : : !! FUNCTION
2732 : : !! Generic routine to read/write wf files with MPI I/O.
2733 : : !! Target: double precision two-dimensional arrays.
2734 : : !!
2735 : : !! INPUTS
2736 : : !! n1= first dimension of the array
2737 : : !! n2= second dimension of the array
2738 : : !! spaceComm= MPI communicator
2739 : : !! displace= number of elements for the offset
2740 : : !!
2741 : : !! OUTPUT
2742 : : !! ierr= exit status, a non-zero value meaning there is an error
2743 : : !! xval= data buffer array
2744 : : !!
2745 : : !! SIDE EFFECTS
2746 : : !! wff= structured info for reading/writing the wavefunctions
2747 : : !!
2748 : : !! SOURCE
2749 : :
2750 [ # # # # ]: 0 : subroutine xderiveRead_dp2d_displ(wff,xval,n1,n2,spaceComm,displace,ierr)
2751 : :
2752 : : !Arguments ------------------------------------
2753 : : type(wffile_type),intent(inout) :: wff
2754 : : integer,intent(in) :: n1,n2,spaceComm
2755 : : integer,intent(out) :: ierr
2756 : : real(dp),intent(out):: xval(:,:)
2757 : : integer,intent(in):: displace(:)
2758 : :
2759 : : !Local variables-------------------------------
2760 : : #if defined HAVE_MPI_IO
2761 : : !scalars
2762 : : integer :: filetype,i1,i2,ipos,nb,nbval,totsize,wfftempo
2763 : : !arrays
2764 : : integer :: statux(MPI_STATUS_SIZE)
2765 : 0 : integer,allocatable :: length1(:),type1(:)
2766 : 0 : integer(kind=MPI_OFFSET_KIND),allocatable :: depl(:),depl1(:),depl_val(:)
2767 : 0 : real(dp), allocatable :: buf_val(:),val(:)
2768 : : #endif
2769 : :
2770 : : ! *********************************************************************
2771 : :
2772 [ # # # # ]: 0 : xval(:,:)=zero ; ierr=0
2773 : : if(.false.)write(std_out,*)wff%me,n1,n2,displace,spaceComm
2774 : :
2775 : : #if defined HAVE_MPI_IO
2776 : 0 : nb=n1*n2
2777 : 0 : call xmpi_sum(nb,totsize,spaceComm,ierr)
2778 [ # # # # : 0 : ABI_MALLOC(depl_val,(0:totsize-1))
# # # # #
# # # ]
2779 [ # # # # : 0 : ABI_MALLOC(depl,(nb))
# # # # #
# # # ]
2780 [ # # # # : 0 : ABI_MALLOC(buf_val,(0:totsize-1))
# # # # ]
2781 [ # # # # : 0 : ABI_MALLOC(val,(nb))
# # # # ]
2782 : :
2783 : : !Map displacements
2784 [ # # ]: 0 : depl_val(0:totsize-1)=-1
2785 [ # # ]: 0 : do i2=1,n2
2786 [ # # ]: 0 : do i1=1,n1
2787 : 0 : ipos=(displace(i2)-1)*n1 + i1-1
2788 : 0 : depl_val(ipos)=ipos
2789 : : end do
2790 : : end do
2791 : : !To save time, the location describe by array map must be in increasing order
2792 : 0 : nbval=0
2793 [ # # ]: 0 : do i1=0,totsize-1
2794 [ # # ]: 0 : if (depl_val(i1)/=-1) then
2795 : 0 : nbval=nbval+1
2796 : 0 : depl(nbval)=depl_val(i1)
2797 : : end if
2798 : : end do
2799 : :
2800 : : !Build MPI datatype for view
2801 [ # # # # : 0 : ABI_MALLOC(length1,(nbval+2))
# # # # #
# # # #
# ]
2802 [ # # # # : 0 : ABI_MALLOC(depl1,(nbval+2))
# # # # #
# # # ]
2803 [ # # # # : 0 : ABI_MALLOC(type1,(nbval+2))
# # # # ]
2804 : 0 : length1(1)=1;depl1(1)=0;type1(1)=MPI_LB
2805 [ # # ]: 0 : do i1=2,nbval+1
2806 : 0 : length1(i1) = 1
2807 : 0 : depl1(i1)= depl(i1-1)*wff%nbOct_dp
2808 : 0 : type1(i1)= MPI_DOUBLE_PRECISION
2809 : : end do
2810 : 0 : length1(nbval+2)=1;depl1(nbval+2)=totsize*wff%nbOct_dp;type1(nbval+2)=MPI_UB
2811 : 0 : call xmpio_type_struct(nbval+2,length1,depl1,type1,filetype,ierr)
2812 : 0 : call MPI_TYPE_COMMIT(filetype,ierr)
2813 : 0 : ABI_FREE(length1)
2814 : 0 : ABI_FREE(depl1)
2815 : 0 : ABI_FREE(type1)
2816 : :
2817 : : !Read data (read-only: the file may not be writable)
2818 : 0 : call MPI_FILE_OPEN(spaceComm,wff%fname,MPI_MODE_RDONLY,MPI_INFO_NULL,wfftempo,ierr)
2819 : 0 : ABI_CHECK_MPI(ierr, sjoin("MPI_FILE_OPEN:", wff%fname))
2820 : 0 : call MPI_FILE_SET_VIEW(wfftempo,wff%offwff,MPI_BYTE,filetype,"native",MPI_INFO_NULL,ierr)
2821 : 0 : call MPI_FILE_READ_ALL(wfftempo,val,nbval,MPI_DOUBLE_PRECISION,statux,ierr)
2822 : 0 : call MPI_FILE_CLOSE(wfftempo,ierr)
2823 : :
2824 : : !Retrieve xval
2825 : 0 : nbval=0
2826 [ # # ]: 0 : do i1=0,totsize-1
2827 [ # # ]: 0 : if (depl_val(i1)/=-1) then
2828 : 0 : nbval=nbval+1
2829 : 0 : buf_val(i1)=val(nbval)
2830 : : end if
2831 : : end do
2832 [ # # ]: 0 : do i2=1,n2
2833 [ # # ]: 0 : do i1=1,n1
2834 : 0 : ipos=(displace(i2)-1)*n1 + i1-1
2835 : 0 : xval(i1,i2)=buf_val(ipos)
2836 : : end do
2837 : : end do
2838 : :
2839 : : !Update offset
2840 : 0 : wff%offwff = wff%offwff + totsize*wff%nbOct_dp
2841 : :
2842 : : !Free memory
2843 : 0 : call MPI_TYPE_FREE(filetype,ierr)
2844 [ # # ]: 0 : ABI_FREE(depl)
2845 [ # # ]: 0 : ABI_FREE(depl_val)
2846 [ # # ]: 0 : ABI_FREE(buf_val)
2847 [ # # ]: 0 : ABI_FREE(val)
2848 : : #endif
2849 : :
2850 : 0 : end subroutine xderiveRead_dp2d_displ
2851 : : !!***
2852 : :
2853 : : !----------------------------------------------------------------------
2854 : :
2855 : : !!****f* m_wffile/xderiveReadVal_char
2856 : : !! NAME
2857 : : !! xderiveReadVal_char
2858 : : !!
2859 : : !! FUNCTION
2860 : : !! Generic routine to read/write wf files with MPI I/O.
2861 : : !! Target: character string.
2862 : : !!
2863 : : !! INPUTS
2864 : : !! n= number of elements in the array
2865 : : !!
2866 : : !! OUTPUT
2867 : : !! xval= data buffer array
2868 : : !! ierr= exit status, a non-zero value meaning there is an error
2869 : : !!
2870 : : !! SIDE EFFECTS
2871 : : !! wff= structured info for reading/writing the wavefunctions
2872 : : !!
2873 : : !! SOURCE
2874 : :
2875 : 0 : subroutine xderiveReadVal_char(wff,xval,n,ierr)
2876 : :
2877 : : !Arguments ------------------------------------
2878 : : type(wffile_type),intent(inout) :: wff
2879 : : integer,intent(in) :: n
2880 : : integer,intent(out) :: ierr
2881 : : character(len=*),intent(out),target :: xval
2882 : :
2883 : : !Local variables-------------------------------
2884 : : #if defined HAVE_MPI_IO
2885 : : integer :: statux(MPI_STATUS_SIZE)
2886 : : character,pointer :: arr_xval(:)
2887 : : type(c_ptr) :: cptr
2888 : : #endif
2889 : :
2890 : : ! *********************************************************************
2891 : :
2892 : 0 : xval=' ' ; ierr=0
2893 : : if(.false.)write(std_out,*)wff%me,n
2894 : :
2895 : : #if defined HAVE_MPI_IO
2896 [ # # ]: 0 : cptr=c_loc(xval) ; call c_f_pointer(cptr,arr_xval,[n])
2897 [ # # ]: 0 : call MPI_FILE_READ_AT(wff%fhwff,wff%offwff,arr_xval,n,MPI_CHARACTER,statux,ierr)
2898 : 0 : wff%offwff = wff%offwff + wff%nbOct_ch * n
2899 : : #endif
2900 : :
2901 [ # # ]: 0 : end subroutine xderiveReadVal_char
2902 : : !!***
2903 : :
2904 : : !----------------------------------------------------------------------
2905 : :
2906 : : !!****f* m_wffile/xmpi_read_int2d
2907 : : !! NAME
2908 : : !! xmpi_read_int2d
2909 : : !!
2910 : : !! FUNCTION
2911 : : !! Generic routine to read arrays with MPI I/O.
2912 : : !! Target: integer two-dimensional arrays.
2913 : : !!
2914 : : !! INPUTS
2915 : : !! sc_mode=
2916 : : !! xmpio_single ==> Local reading.
2917 : : !! xmpio_collective ==> Collective reading.
2918 : : !! spaceComm= MPI communicator
2919 : : !!
2920 : : !! OUTPUT
2921 : : !! xval= data buffer array
2922 : : !! ierr= exit status, a non-zero value meaning there is an error
2923 : : !!
2924 : : !! SIDE EFFECTS
2925 : : !! wff= structured info for reading/writing the wavefunctions
2926 : : !!
2927 : : !! SOURCE
2928 : :
2929 [ # # ]: 0 : subroutine xmpi_read_int2d(wff,xval,spaceComm,sc_mode,ierr)
2930 : :
2931 : : !Arguments ------------------------------------
2932 : : !scalars
2933 : : integer,intent(in) :: spaceComm,sc_mode
2934 : : integer,intent(out) :: ierr
2935 : : type(wffile_type),intent(inout) :: wff
2936 : : !array
2937 : : integer,intent(out) :: xval(:,:)
2938 : :
2939 : : !Local variables-------------------------------
2940 : : integer :: n1,n2
2941 : : #ifdef HAVE_MPI_IO
2942 : : integer(kind=MPI_OFFSET_KIND) :: delim_record,nboct,posit,totoct
2943 : : character(len=500) :: msg
2944 : : !arrays
2945 : : integer :: statux(MPI_STATUS_SIZE)
2946 : : #endif
2947 : :
2948 : : ! *********************************************************************
2949 : :
2950 : 0 : ierr=0
2951 : 0 : n1 = SIZE(xval,DIM=1)
2952 : 0 : n2 = SIZE(xval,DIM=2)
2953 : :
2954 : : #ifdef HAVE_MPI_IO
2955 : 0 : nboct = wff%nbOct_int * n1 *n2
2956 : 0 : posit = wff%offwff
2957 : 0 : delim_record = posit - wff%off_recs + wff%lght_recs - wff%nbOct_recMarker
2958 : :
2959 [ # # ]: 0 : if (delim_record >= nboct) then
2960 : :
2961 : 0 : select case (sc_mode)
2962 : : case (xmpio_single)
2963 [ # # ]: 0 : call MPI_FILE_READ_AT(wff%fhwff,posit,xval,n1*n2,MPI_INTEGER,statux,ierr)
2964 : :
2965 : : case (xmpio_collective)
2966 [ # # ]: 0 : call MPI_FILE_READ_AT_ALL(wff%fhwff,posit,xval,n1*n2,MPI_INTEGER,statux,ierr)
2967 : :
2968 : : case default
2969 : 0 : write(msg,('(a,i0)'))" Wrong value for sc_mode: ",sc_mode
2970 [ # # # ]: 0 : ABI_ERROR(msg)
2971 : : end select
2972 : :
2973 : : totoct=nboct
2974 : : else
2975 : 0 : write(msg,('(a,2(i0,1x))'))" delim_record < nboct: ",delim_record,nboct
2976 : 0 : ABI_WARNING(msg)
2977 : 0 : ierr=MPI_ERR_UNKNOWN
2978 : 0 : totoct=0
2979 : : end if
2980 : : !
2981 : : !Increment the offset.
2982 : 0 : wff%offwff=wff%offwff + totoct
2983 : : #endif
2984 : :
2985 : 0 : RETURN
2986 : : ABI_UNUSED(xval(1,1))
2987 : : ABI_UNUSED((/wff%me,spaceComm,sc_mode/))
2988 : :
2989 : : end subroutine xmpi_read_int2d
2990 : : !!***
2991 : :
2992 : : !----------------------------------------------------------------------
2993 : :
2994 : : !!****f* m_wffile/xderiveWrite_int
2995 : : !! NAME
2996 : : !! xderiveWrite_int
2997 : : !!
2998 : : !! FUNCTION
2999 : : !! Generic routine to read/write wf files with MPI I/O.
3000 : : !! Target: integer scalar.
3001 : : !!
3002 : : !! INPUTS
3003 : : !! xval= data buffer
3004 : : !!
3005 : : !! OUTPUT
3006 : : !! ierr= exit status, a non-zero value meaning there is an error
3007 : : !!
3008 : : !! SIDE EFFECTS
3009 : : !! wff= structured info for reading/writing the wavefunctions
3010 : : !!
3011 : : !! SOURCE
3012 : :
3013 : 45 : subroutine xderiveWrite_int(wff,xval,ierr)
3014 : :
3015 : : !Arguments ------------------------------------
3016 : : integer,intent(out) :: ierr
3017 : : integer,intent(in):: xval
3018 : : type(wffile_type),intent(inout) :: wff
3019 : :
3020 : : !Local variables-------------------------------
3021 : : #if defined HAVE_MPI_IO
3022 : : integer :: statux(MPI_STATUS_SIZE),arr_xval(1)
3023 : : #endif
3024 : : ! *********************************************************************
3025 : :
3026 : 45 : ierr=0
3027 : : if(.false.)write(std_out,*)wff%me,xval
3028 : : #if defined HAVE_MPI_IO
3029 : 45 : arr_xval(1) = xval
3030 : 45 : call MPI_FILE_WRITE_AT(wff%fhwff,wff%offwff,arr_xval,1,MPI_INTEGER,statux,ierr)
3031 : 45 : wff%offwff = wff%offwff+wff%nbOct_int
3032 : : #endif
3033 : :
3034 : 45 : end subroutine xderiveWrite_int
3035 : : !!***
3036 : :
3037 : : !----------------------------------------------------------------------
3038 : :
3039 : :
3040 : : !!****f* m_wffile/xderiveWrite_int1d
3041 : : !! NAME
3042 : : !! xderiveWrite_int1d
3043 : : !!
3044 : : !! FUNCTION
3045 : : !! Generic routine to read/write wf files with MPI I/O.
3046 : : !! Target: one-dimensional integer arrays.
3047 : : !!
3048 : : !! INPUTS
3049 : : !! n1= first dimension of the array
3050 : : !! spaceComm= MPI communicator
3051 : : !! xval= data buffer array
3052 : : !!
3053 : : !! OUTPUT
3054 : : !! ierr= exit status, a non-zero value meaning there is an error
3055 : : !!
3056 : : !! SIDE EFFECTS
3057 : : !! wff= structured info for reading/writing the wavefunctions
3058 : : !!
3059 : : !! SOURCE
3060 : :
3061 [ # # ]: 0 : subroutine xderiveWrite_int1d(wff,xval,n1,spaceComm,ierr)
3062 : :
3063 : : !Arguments ------------------------------------
3064 : : integer,intent(in) :: n1,spaceComm
3065 : : integer,intent(out) :: ierr
3066 : : integer,intent(in):: xval(:)
3067 : : type(wffile_type),intent(inout) :: wff
3068 : :
3069 : : !Local variables-------------------------------
3070 : : #if defined HAVE_MPI_IO
3071 : : integer(kind=MPI_OFFSET_KIND) :: nboct,dispoct(1),posit,totoct
3072 : : integer :: statux(MPI_STATUS_SIZE)
3073 : : #endif
3074 : : ! *********************************************************************
3075 : :
3076 : 0 : ierr=0
3077 : : if(.false.)write(std_out,*)wff%me,n1,spaceComm,xval
3078 : : #if defined HAVE_MPI_IO
3079 : 0 : nboct = n1*wff%nbOct_int
3080 : 0 : posit = wff%offwff
3081 : :
3082 : : !dispoct = sum (nboct, rank=0..me)
3083 [ # # ]: 0 : if (spaceComm/=MPI_COMM_SELF) then
3084 [ # # ]: 0 : call MPI_SCAN([nboct],dispoct,1,wff%offset_mpi_type,MPI_SUM,spaceComm,ierr)
3085 : 0 : posit = posit + dispoct(1) - nboct
3086 : : end if
3087 [ # # ]: 0 : call MPI_FILE_WRITE_AT(wff%fhwff,posit,xval,n1,MPI_INTEGER,statux,ierr)
3088 : : !gather the bigest offset
3089 : :
3090 [ # # ]: 0 : if (spaceComm/=MPI_COMM_SELF) then
3091 : 0 : call xmpi_max(dispoct(1),totoct,spaceComm,ierr)
3092 : : !call MPI_ALLREDUCE(dispoct,totoct,1,wff%offset_mpi_type,MPI_MAX,spaceComm,ierr)
3093 : : else
3094 : 0 : totoct=nboct
3095 : : end if
3096 : 0 : wff%offwff = wff%offwff + totoct
3097 : :
3098 : : !Disable old code
3099 : : #endif
3100 : :
3101 : 0 : end subroutine xderiveWrite_int1d
3102 : : !!***
3103 : :
3104 : : !----------------------------------------------------------------------
3105 : :
3106 : : !!****f* m_wffile/xderiveWrite_int2d
3107 : : !! NAME
3108 : : !! xderiveWrite_int2d
3109 : : !!
3110 : : !! FUNCTION
3111 : : !! Generic routine to read/write wf files with MPI I/O.
3112 : : !! Target: two-dimensional integer arrays.
3113 : : !!
3114 : : !! INPUTS
3115 : : !! n1= first dimension of the array
3116 : : !! n2= second dimension of the array
3117 : : !! spaceComm= MPI communicator
3118 : : !! xval= data buffer array
3119 : : !!
3120 : : !! OUTPUT
3121 : : !! ierr= exit status, a non-zero value meaning there is an error
3122 : : !!
3123 : : !! SIDE EFFECTS
3124 : : !! wff= structured info for reading/writing the wavefunctions
3125 : : !!
3126 : : !! SOURCE
3127 : :
3128 [ # # ]: 0 : subroutine xderiveWrite_int2d(wff,xval,n1,n2,spaceComm,ierr)
3129 : :
3130 : : !Arguments ------------------------------------
3131 : : integer,intent(in) :: n1,n2,spaceComm
3132 : : integer,intent(out) :: ierr
3133 : : integer,intent(in):: xval(:,:)
3134 : : type(wffile_type),intent(inout) :: wff
3135 : :
3136 : : !Local variables-------------------------------
3137 : : #if defined HAVE_MPI_IO
3138 : : integer(kind=MPI_OFFSET_KIND) :: nboct,dispoct(1),posit,totoct
3139 : : integer :: statux(MPI_STATUS_SIZE)
3140 : : #endif
3141 : :
3142 : : ! *********************************************************************
3143 : :
3144 : 0 : ierr=0
3145 : : if(.false.)write(std_out,*)wff%me,n1,n2,spaceComm,xval
3146 : : #if defined HAVE_MPI_IO
3147 : 0 : nboct = n1*n2*wff%nbOct_int
3148 : 0 : posit = wff%offwff
3149 : :
3150 : : !dispoct = sum(nboct, rank=0..me)
3151 [ # # ]: 0 : if (spaceComm/=MPI_COMM_SELF) then
3152 [ # # ]: 0 : call MPI_SCAN([nboct],dispoct,1,wff%offset_mpi_type,MPI_SUM,spaceComm,ierr)
3153 : 0 : posit = posit + dispoct(1) - nboct
3154 : : end if
3155 [ # # ]: 0 : call MPI_FILE_WRITE_AT(wff%fhwff,posit,xval,n1*n2,MPI_INTEGER,statux,ierr)
3156 : : !gather the biggest offset
3157 [ # # ]: 0 : if (spaceComm/=MPI_COMM_SELF) then
3158 : 0 : call xmpi_max(dispoct(1),totoct,spaceComm,ierr)
3159 : : !call MPI_ALLREDUCE(dispoct,totoct,1,wff%offset_mpi_type,MPI_MAX,spaceComm,ierr)
3160 : : else
3161 : 0 : totoct=nboct
3162 : : end if
3163 : 0 : wff%offwff = wff%offwff + totoct
3164 : : #endif
3165 : :
3166 : 0 : end subroutine xderiveWrite_int2d
3167 : : !!***
3168 : :
3169 : : !----------------------------------------------------------------------
3170 : :
3171 : :
3172 : : !!****f* m_wffile/xderiveWrite_dp
3173 : : !! NAME
3174 : : !! xderiveWrite_dp
3175 : : !!
3176 : : !! FUNCTION
3177 : : !! Generic routine to read/write wf files with MPI I/O.
3178 : : !! Target: double precision scalar.
3179 : : !!
3180 : : !! INPUTS
3181 : : !! xval= data buffer
3182 : : !!
3183 : : !! OUTPUT
3184 : : !! ierr= exit status, a non-zero value meaning there is an error
3185 : : !!
3186 : : !! SIDE EFFECTS
3187 : : !! wff= structured info for reading/writing the wavefunctions
3188 : : !!
3189 : : !! SOURCE
3190 : :
3191 : 0 : subroutine xderiveWrite_dp(wff,xval,ierr)
3192 : :
3193 : : !Arguments ------------------------------------
3194 : : integer,intent(out) :: ierr
3195 : : real(dp),intent(in):: xval
3196 : : type(wffile_type),intent(inout) :: wff
3197 : :
3198 : : !Local variables-------------------------------
3199 : : #if defined HAVE_MPI_IO
3200 : : integer :: statux(MPI_STATUS_SIZE)
3201 : : #endif
3202 : : ! *********************************************************************
3203 : :
3204 : 0 : ierr=0
3205 : : if(.false.)write(std_out,*)wff%me,xval
3206 : : #if defined HAVE_MPI_IO
3207 [ # # ]: 0 : call MPI_FILE_WRITE_AT(wff%fhwff,wff%offwff,[xval],1,MPI_DOUBLE_PRECISION,statux,ierr)
3208 : 0 : wff%offwff = wff%offwff+wff%nbOct_dp
3209 : : #endif
3210 : :
3211 : 0 : end subroutine xderiveWrite_dp
3212 : : !!***
3213 : :
3214 : : !----------------------------------------------------------------------
3215 : :
3216 : :
3217 : : !!****f* m_wffile/xderiveWrite_dp1d
3218 : : !! NAME
3219 : : !! xderiveWrite_dp1d
3220 : : !!
3221 : : !! FUNCTION
3222 : : !! Generic routine to read/write wf files with MPI I/O.
3223 : : !! Target: one-dimensional double precision arrays.
3224 : : !!
3225 : : !! INPUTS
3226 : : !! n1= first dimension of the array
3227 : : !! spaceComm= MPI communicator
3228 : : !! xval= data buffer array
3229 : : !!
3230 : : !! OUTPUT
3231 : : !! ierr= exit status, a non-zero value meaning there is an error
3232 : : !!
3233 : : !! SIDE EFFECTS
3234 : : !! wff= structured info for reading/writing the wavefunctions
3235 : : !!
3236 : : !! SOURCE
3237 : :
3238 [ - + ]: 30 : subroutine xderiveWrite_dp1d(wff,xval,n1,spaceComm,ierr)
3239 : :
3240 : : !Arguments ------------------------------------
3241 : : integer,intent(in) :: n1,spaceComm
3242 : : integer,intent(out) :: ierr
3243 : : real(dp),intent(in):: xval(:)
3244 : : type(wffile_type),intent(inout) :: wff
3245 : :
3246 : : !Local variables-------------------------------
3247 : : #if defined HAVE_MPI_IO
3248 : : integer(kind=MPI_OFFSET_KIND) :: nboct,dispoct(1),posit,totoct
3249 : : integer :: statux(MPI_STATUS_SIZE)
3250 : : #endif
3251 : :
3252 : : ! *********************************************************************
3253 : :
3254 : 30 : ierr=0
3255 : : if(.false.)write(std_out,*)wff%me,n1,spaceComm,xval
3256 : : #if defined HAVE_MPI_IO
3257 : 30 : nboct = n1*wff%nbOct_dp
3258 : 30 : posit = wff%offwff
3259 : : !dispoct = sum (nboct, rank = 0..me)
3260 [ - + ]: 30 : if (spaceComm/=MPI_COMM_SELF) then
3261 [ # # ]: 0 : call MPI_SCAN([nboct],dispoct,1,wff%offset_mpi_type,MPI_SUM,spaceComm,ierr)
3262 : 0 : posit = posit + dispoct(1) - nboct
3263 : : end if
3264 [ - + ]: 30 : call MPI_FILE_WRITE_AT(wff%fhwff,posit,xval,n1,MPI_DOUBLE_PRECISION,statux,ierr)
3265 : : !Gather the biggest offset
3266 [ - + ]: 30 : if (spaceComm/=MPI_COMM_SELF) then
3267 : 0 : call xmpi_max(dispoct(1),totoct,spaceComm,ierr)
3268 : : !call MPI_ALLREDUCE(dispoct,totoct,1,wff%offset_mpi_type,MPI_MAX,spaceComm,ierr)
3269 : : else
3270 : 30 : totoct=nboct
3271 : : end if
3272 : 30 : wff%offwff = wff%offwff + totoct
3273 : : #endif
3274 : :
3275 : 30 : end subroutine xderiveWrite_dp1d
3276 : : !!***
3277 : :
3278 : : !----------------------------------------------------------------------
3279 : :
3280 : : !!****f* m_wffile/xderiveWrite_dp2d
3281 : : !! NAME
3282 : : !! xderiveWrite_dp2d
3283 : : !!
3284 : : !! FUNCTION
3285 : : !! Generic routine to read/write wf files with MPI I/O.
3286 : : !! Target: double precision two-dimensional arrays.
3287 : : !!
3288 : : !! INPUTS
3289 : : !! n1= first dimension of the array
3290 : : !! n2= second dimension of the array
3291 : : !! spaceComm= MPI communicator
3292 : : !! xval= data buffer array
3293 : : !!
3294 : : !! OUTPUT
3295 : : !! ierr= exit status, a non-zero value meaning there is an error
3296 : : !!
3297 : : !! SIDE EFFECTS
3298 : : !! wff= structured info for reading/writing the wavefunctions
3299 : : !!
3300 : : !! SOURCE
3301 : :
3302 [ # # ]: 0 : subroutine xderiveWrite_dp2d(wff,xval,n1,n2,spaceComm,ierr)
3303 : :
3304 : : !Arguments ------------------------------------
3305 : : integer,intent(in) :: n1,n2,spaceComm
3306 : : integer,intent(out) :: ierr
3307 : : real(dp),intent(in):: xval(:,:)
3308 : : type(wffile_type),intent(inout) :: wff
3309 : :
3310 : : !Local variables-------------------------------
3311 : : #if defined HAVE_MPI_IO
3312 : : integer(kind=MPI_OFFSET_KIND) :: nboct,dispoct(1),posit,totoct
3313 : : integer :: statux(MPI_STATUS_SIZE)
3314 : : #endif
3315 : :
3316 : : ! *********************************************************************
3317 : :
3318 : 0 : ierr=0
3319 : : if(.false.)write(std_out,*)wff%me,xval,n1,n2,spaceComm
3320 : :
3321 : : #if defined HAVE_MPI_IO
3322 : 0 : nboct = n1*n2*wff%nbOct_dp
3323 : 0 : posit = wff%offwff
3324 : : !dispoct = sum(nboct, rank=0..me)
3325 [ # # ]: 0 : if (spaceComm/=MPI_COMM_SELF) then
3326 [ # # ]: 0 : call MPI_SCAN([nboct],dispoct,1,wff%offset_mpi_type,MPI_SUM,spaceComm,ierr)
3327 : 0 : posit = posit + dispoct(1) - nboct
3328 : : end if
3329 [ # # ]: 0 : call MPI_FILE_WRITE_AT(wff%fhwff,posit,xval,n1*n2,MPI_DOUBLE_PRECISION,statux,ierr)
3330 : 0 : posit = posit + nboct
3331 : : !gather the biggest offset
3332 [ # # ]: 0 : if (spaceComm/=MPI_COMM_SELF) then
3333 : 0 : call xmpi_max(dispoct(1),totoct,spaceComm,ierr)
3334 : : !call MPI_ALLREDUCE(dispoct,totoct,1,wff%offset_mpi_type,MPI_MAX,spaceComm,ierr)
3335 : : else
3336 : 0 : totoct=nboct
3337 : : end if
3338 : 0 : wff%offwff = wff%offwff + totoct
3339 : : #endif
3340 : :
3341 : 0 : end subroutine xderiveWrite_dp2d
3342 : : !!***
3343 : :
3344 : : !----------------------------------------------------------------------
3345 : :
3346 : : !!****f* m_wffile/xderiveWrite_dp2d_seq
3347 : : !! NAME
3348 : : !! xderiveWrite_dp2d_seq
3349 : : !!
3350 : : !! FUNCTION
3351 : : !! Generic routine to read/write wf files with MPI I/O.
3352 : : !! Target: double precision two-dimensional arrays.
3353 : : !!
3354 : : !! INPUTS
3355 : : !! xval= data buffer array
3356 : : !!
3357 : : !! OUTPUT
3358 : : !! ierr= exit status, a non-zero value meaning there is an error
3359 : : !!
3360 : : !! SIDE EFFECTS
3361 : : !! wff= structured info for reading/writing the wavefunctions
3362 : : !!
3363 : : !! SOURCE
3364 : :
3365 [ # # ]: 0 : subroutine xderiveWrite_dp2d_seq(wff,xval,ierr)
3366 : :
3367 : : !Arguments ------------------------------------
3368 : : integer,intent(out) :: ierr
3369 : : real(dp),intent(in):: xval(:,:)
3370 : : type(wffile_type),intent(inout) :: wff
3371 : :
3372 : : !Local variables-------------------------------
3373 : : #if defined HAVE_MPI_IO
3374 : : integer :: n1,n2
3375 : : integer :: statux(MPI_STATUS_SIZE)
3376 : : #endif
3377 : : ! *********************************************************************
3378 : :
3379 : 0 : ierr=0
3380 : : if(.false.)write(std_out,*)wff%me,xval
3381 : : #if defined HAVE_MPI_IO
3382 : 0 : n1=size(xval,1);n2=size(xval,2)
3383 [ # # ]: 0 : call MPI_FILE_WRITE_AT(wff%fhwff,wff%offwff,xval,n1*n2,MPI_DOUBLE_PRECISION,statux,ierr)
3384 : 0 : wff%offwff = wff%offwff+wff%nbOct_dp*n1*n2
3385 : : #endif
3386 : :
3387 : 0 : end subroutine xderiveWrite_dp2d_seq
3388 : : !!***
3389 : :
3390 : : !----------------------------------------------------------------------
3391 : :
3392 : :
3393 : : !!****f* m_wffile/xderiveWrite_int2d_displ
3394 : : !! NAME
3395 : : !! xderiveWrite_int2d_displ
3396 : : !!
3397 : : !! FUNCTION
3398 : : !! Generic routine to read/write wf files with MPI I/O.
3399 : : !! Target: two-dimensional integer arrays.
3400 : : !!
3401 : : !! INPUTS
3402 : : !! n1= first dimension of the array
3403 : : !! n2= second dimension of the array
3404 : : !! spaceComm= MPI communicator
3405 : : !! xval= data buffer array
3406 : : !! displace= number of elements for the offset
3407 : : !!
3408 : : !! OUTPUT
3409 : : !! ierr= exit status, a non-zero value meaning there is an error
3410 : : !!
3411 : : !! SIDE EFFECTS
3412 : : !! wff= structured info for reading/writing the wavefunctions
3413 : : !!
3414 : : !! SOURCE
3415 : :
3416 [ - + - + ]: 38 : subroutine xderiveWrite_int2d_displ(wff,xval,n1,n2,spaceComm,displace,ierr)
3417 : :
3418 : : !Arguments ------------------------------------
3419 : : integer,intent(in) :: n1,n2,spaceComm
3420 : : integer,intent(out) :: ierr
3421 : : integer,intent(in):: displace(:),xval(:,:)
3422 : : type(wffile_type),intent(inout) :: wff
3423 : :
3424 : : !Local variables-------------------------------
3425 : : #if defined HAVE_MPI_IO
3426 : : !scalars
3427 : : integer :: filetype,i1,i2,ipos,nb,nbval,totsize,wfftempo
3428 : : !arrays
3429 : : integer :: statux(MPI_STATUS_SIZE)
3430 : 38 : integer, allocatable :: buf_val(:),length1(:),type1(:),val(:)
3431 : 38 : integer(kind=MPI_OFFSET_KIND),allocatable :: depl(:),depl1(:),depl_val(:)
3432 : : #endif
3433 : :
3434 : : ! *********************************************************************
3435 : :
3436 : : ierr=0
3437 : : if(.false.)write(std_out,*)wff%me,xval,n1,n2,spaceComm,displace
3438 : :
3439 : : #if defined HAVE_MPI_IO
3440 : 38 : nb = n1*n2
3441 : 38 : call xmpi_sum(nb,totsize,spaceComm,ierr)
3442 [ - + + - : 114 : ABI_MALLOC(depl_val,(0:totsize-1))
+ - + - -
+ - + ]
3443 [ - + + - : 114 : ABI_MALLOC(depl,(nb))
+ - + - -
+ - + ]
3444 [ - + + - : 114 : ABI_MALLOC(buf_val,(0:totsize-1))
+ - + - -
+ - + ]
3445 [ - + + - : 114 : ABI_MALLOC(val,(nb))
+ - + - -
+ - + ]
3446 : :
3447 : : !Map displacements
3448 : : !Put xval in a buffer at its position
3449 [ + + ]: 50648 : depl_val(0:totsize-1)=-1
3450 [ + + ]: 7613 : do i2=1,n2
3451 [ + + ]: 30338 : do i1=1,n1
3452 : : ! ipos location of xval(i1,i2) in the array associated with record to be written
3453 : 22725 : ipos=(displace(i2)-1)*n1 + i1-1
3454 : 22725 : buf_val(ipos) = xval(i1,i2)
3455 : 30300 : depl_val(ipos) = ipos
3456 : : end do
3457 : : end do
3458 : : !To save time, the location describe by array map must be in increasing order
3459 : 38 : nbval=0
3460 [ + + ]: 50648 : do i1=0,totsize-1
3461 [ + + ]: 50648 : if (depl_val(i1)/=-1) then
3462 : 22725 : nbval=nbval+1
3463 : 22725 : val(nbval)=buf_val(i1)
3464 : 22725 : depl(nbval)=depl_val(i1)
3465 : : end if
3466 : : end do
3467 : :
3468 : : !Build MPI datatype for view
3469 [ + - - + : 114 : ABI_MALLOC(length1,(nbval+2))
+ - + - +
- - + -
+ ]
3470 [ - + + - : 114 : ABI_MALLOC(depl1,(nbval+2))
+ - + - -
+ - + ]
3471 [ - + + - : 76 : ABI_MALLOC(type1,(nbval+2))
- + - + ]
3472 : 38 : length1(1)=1;depl1(1)=0;type1(1)=MPI_LB
3473 [ + + ]: 22763 : do i1=2,nbval+1
3474 : 22725 : length1(i1) = 1
3475 : 22725 : depl1(i1)= depl(i1-1)*wff%nbOct_int
3476 : 22763 : type1(i1)= MPI_INTEGER
3477 : : end do
3478 : 38 : length1(nbval+2)=1;depl1(nbval+2)=totsize*wff%nbOct_int;type1(nbval+2)=MPI_UB
3479 : 38 : call xmpio_type_struct(nbval+2,length1,depl1,type1,filetype,ierr)
3480 : 38 : call MPI_TYPE_COMMIT(filetype,ierr)
3481 : 38 : ABI_FREE(length1)
3482 : 38 : ABI_FREE(depl1)
3483 : 38 : ABI_FREE(type1)
3484 : :
3485 : : !Write data
3486 : 38 : call MPI_FILE_OPEN(spaceComm,wff%fname,MPI_MODE_RDWR,MPI_INFO_NULL,wfftempo,ierr)
3487 : 38 : ABI_CHECK_MPI(ierr, sjoin("MPI_FILE_OPEN:", wff%fname))
3488 : 38 : call MPI_FILE_SET_VIEW(wfftempo,wff%offwff,MPI_BYTE,filetype,"native",MPI_INFO_NULL,ierr)
3489 : 38 : call MPI_FILE_WRITE_ALL(wfftempo,val,nbval,MPI_INTEGER,statux,ierr)
3490 : 38 : call MPI_FILE_CLOSE(wfftempo,ierr)
3491 : :
3492 : : !Update offset
3493 : 38 : wff%offwff = wff%offwff + totsize*wff%nbOct_int
3494 : :
3495 : : !Free memory
3496 : 38 : call MPI_TYPE_FREE(filetype,ierr)
3497 [ - + ]: 38 : ABI_FREE(depl)
3498 [ - + ]: 38 : ABI_FREE(depl_val)
3499 [ - + ]: 38 : ABI_FREE(buf_val)
3500 [ - + ]: 38 : ABI_FREE(val)
3501 : : #endif
3502 : :
3503 : 38 : end subroutine xderiveWrite_int2d_displ
3504 : : !!***
3505 : :
3506 : : !----------------------------------------------------------------------
3507 : :
3508 : : !!****f* m_wffile/xderiveWrite_dp2d_displ
3509 : : !! NAME
3510 : : !! xderiveWrite_dp2d_displ
3511 : : !!
3512 : : !! FUNCTION
3513 : : !! Generic routine to read/write wf files with MPI I/O.
3514 : : !! Target: two-dimensional double precision arrays.
3515 : : !!
3516 : : !! INPUTS
3517 : : !! n1= first dimension of the array
3518 : : !! n2= second dimension of the array
3519 : : !! spaceComm= MPI communicator
3520 : : !! xval= data buffer array
3521 : : !! displace= number of elements for the offset
3522 : : !!
3523 : : !! OUTPUT
3524 : : !! ierr= exit status, a non-zero value meaning there is an error
3525 : : !!
3526 : : !! SIDE EFFECTS
3527 : : !! wff= structured info for reading/writing the wavefunctions
3528 : : !!
3529 : : !! SOURCE
3530 : :
3531 [ # # # # ]: 0 : subroutine xderiveWrite_dp2d_displ(wff,xval,n1,n2,spaceComm,displace,ierr)
3532 : :
3533 : : !Arguments ------------------------------------
3534 : : integer,intent(in) :: n1,n2,spaceComm
3535 : : integer,intent(out) :: ierr
3536 : : integer,intent(in):: displace(:)
3537 : : real(dp),intent(in) :: xval(:,:)
3538 : : type(wffile_type),intent(inout) :: wff
3539 : :
3540 : : !Local variables-------------------------------
3541 : : #if defined HAVE_MPI_IO
3542 : : !scalars
3543 : : integer :: filetype,i1,i2,ipos,nb,nbval,totsize,wfftempo
3544 : : !arrays
3545 : : integer :: statux(MPI_STATUS_SIZE)
3546 : 0 : integer, allocatable :: length1(:),type1(:)
3547 : 0 : integer(kind=XMPI_ADDRESS_KIND),allocatable :: depl(:),depl1(:),depl_val(:)
3548 : 0 : real(dp),allocatable :: buf_val(:),val(:)
3549 : : #endif
3550 : :
3551 : : ! *********************************************************************
3552 : :
3553 : : ierr=0
3554 : : if(.false.)write(std_out,*)wff%me,xval,n1,n2,spaceComm,displace
3555 : :
3556 : : #if defined HAVE_MPI_IO
3557 : 0 : nb = n1*n2
3558 : 0 : call xmpi_sum(nb,totsize,spaceComm,ierr)
3559 [ # # # # : 0 : ABI_MALLOC(depl_val,(0:totsize-1))
# # # # #
# # # ]
3560 [ # # # # : 0 : ABI_MALLOC(depl,(nb))
# # # # #
# # # ]
3561 [ # # # # : 0 : ABI_MALLOC(buf_val,(0:totsize-1))
# # # # ]
3562 [ # # # # : 0 : ABI_MALLOC(val,(nb))
# # # # ]
3563 : :
3564 : : !Map displacements
3565 : : !Put xval in a buffer at its position
3566 [ # # ]: 0 : depl_val(0:totsize-1)=-1
3567 [ # # ]: 0 : do i2=1,n2
3568 [ # # ]: 0 : do i1=1,n1
3569 : : ! ipos location of xval(i1,i2) in the array associated with record to be written
3570 : 0 : ipos=(displace(i2)-1)*n1 + i1-1
3571 : 0 : buf_val(ipos) = xval(i1,i2)
3572 : 0 : depl_val(ipos) = ipos
3573 : : end do
3574 : : end do
3575 : : !To save time, the location describe by array map must be in increasing order
3576 : 0 : nbval=0
3577 [ # # ]: 0 : do i1=0,totsize-1
3578 [ # # ]: 0 : if (depl_val(i1)/=-1) then
3579 : 0 : nbval=nbval+1
3580 : 0 : val(nbval)=buf_val(i1)
3581 : 0 : depl(nbval)=depl_val(i1)
3582 : : end if
3583 : : end do
3584 : :
3585 : : !Build MPI datatype for view
3586 [ # # # # : 0 : ABI_MALLOC(length1,(nbval+2))
# # # # #
# # # #
# ]
3587 [ # # # # : 0 : ABI_MALLOC(depl1,(nbval+2))
# # # # #
# # # ]
3588 [ # # # # : 0 : ABI_MALLOC(type1,(nbval+2))
# # # # ]
3589 : 0 : length1(1)=1;depl1(1)=0;type1(1)=MPI_LB
3590 [ # # ]: 0 : do i1=2,nbval+1
3591 : 0 : length1(i1) = 1
3592 : 0 : depl1(i1)= depl(i1-1)*wff%nbOct_dp
3593 : 0 : type1(i1)= MPI_DOUBLE_PRECISION
3594 : : end do
3595 : 0 : length1(nbval+2)=1;depl1(nbval+2)=totsize*wff%nbOct_dp;type1(nbval+2)=MPI_UB
3596 : 0 : call xmpio_type_struct(nbval+2,length1,depl1,type1,filetype,ierr)
3597 : 0 : call MPI_TYPE_COMMIT(filetype,ierr)
3598 : 0 : ABI_FREE(length1)
3599 : 0 : ABI_FREE(depl1)
3600 : 0 : ABI_FREE(type1)
3601 : :
3602 : : !Write data
3603 : 0 : call MPI_FILE_OPEN(spaceComm,wff%fname,MPI_MODE_RDWR,MPI_INFO_NULL,wfftempo,ierr)
3604 : 0 : ABI_CHECK_MPI(ierr, sjoin("MPI_FILE_OPEN:", wff%fname))
3605 : 0 : call MPI_FILE_SET_VIEW(wfftempo,wff%offwff,MPI_BYTE,filetype,"native",MPI_INFO_NULL,ierr)
3606 : 0 : call MPI_FILE_WRITE_ALL(wfftempo,val,nbval,MPI_DOUBLE_PRECISION,statux,ierr)
3607 : 0 : call MPI_FILE_CLOSE(wfftempo,ierr)
3608 : :
3609 : 0 : wff%offwff = wff%offwff + totsize*wff%nbOct_dp
3610 : :
3611 : : !Free memory
3612 : 0 : call MPI_TYPE_FREE(filetype,ierr)
3613 [ # # ]: 0 : ABI_FREE(depl)
3614 [ # # ]: 0 : ABI_FREE(depl_val)
3615 [ # # ]: 0 : ABI_FREE(buf_val)
3616 [ # # ]: 0 : ABI_FREE(val)
3617 : : #endif
3618 : :
3619 : 0 : end subroutine xderiveWrite_dp2d_displ
3620 : : !!***
3621 : :
3622 : : !----------------------------------------------------------------------
3623 : :
3624 : :
3625 : : !!****f* m_wffile/xderiveWrite_char
3626 : : !! NAME
3627 : : !! xderiveWrite_char
3628 : : !!
3629 : : !! FUNCTION
3630 : : !! Generic routine to read/write wf files with MPI I/O.
3631 : : !! Target: character string.
3632 : : !!
3633 : : !! INPUTS
3634 : : !! xval= data buffer array
3635 : : !! n= number of elements in the string
3636 : : !!
3637 : : !! OUTPUT
3638 : : !! ierr= exit status, a non-zero value meaning there is an error
3639 : : !!
3640 : : !! SIDE EFFECTS
3641 : : !! wff= structured info for reading/writing the wavefunctions
3642 : : !!
3643 : : !! SOURCE
3644 : :
3645 : 0 : subroutine xderiveWrite_char(wff,xval,n,ierr)
3646 : :
3647 : : !Arguments ------------------------------------
3648 : : type(wffile_type),intent(inout) :: wff
3649 : : integer,intent(in) :: n
3650 : : integer,intent(out) :: ierr
3651 : : character(len=*),intent(in),target :: xval
3652 : :
3653 : : !Local variables-------------------------------
3654 : : #if defined HAVE_MPI_IO
3655 : : integer :: statux(MPI_STATUS_SIZE)
3656 : : character,pointer :: buf(:)
3657 : : type(c_ptr) :: cptr
3658 : : #endif
3659 : : ! *********************************************************************
3660 : :
3661 : 0 : ierr=0
3662 : : if(.false.)write(std_out,*)wff%me,xval,n
3663 : :
3664 : : #if defined HAVE_MPI_IO
3665 [ # # ]: 0 : cptr=c_loc(xval) ; call c_f_pointer(cptr,buf,[n])
3666 [ # # ]: 0 : call MPI_FILE_WRITE_AT(wff%fhwff,wff%offwff,buf,n,MPI_CHARACTER,statux,ierr)
3667 : 0 : wff%offwff = wff%offwff + wff%nbOct_ch * n
3668 : : #endif
3669 : :
3670 : 0 : end subroutine xderiveWrite_char
3671 : : !!***
3672 : :
3673 : : !!****f* m_wffile/xdefineOff
3674 : : !! NAME
3675 : : !! xdefineOff
3676 : : !!
3677 : : !! FUNCTION
3678 : : !! In case of MPI I/O, defines the offset for each processor
3679 : : !!
3680 : : !! INPUTS
3681 : : !! formeig option (format of the eigenvalues and occupations) :
3682 : : !! 0 => ground-state format (initialisation of eigenvectors with
3683 : : !! random numbers, vector of eigenvalues, occupations are present)
3684 : : !! 1 => respfn format (initialisation of eigenvectors with 0 s,
3685 : : !! hermitian matrix of eigenvalues)
3686 : : !! nkpt = number of k points
3687 : : !! nspinor = total number of spinorial components of the wavefunctions
3688 : : !! nsppol = number of channels for spin-polarization (1 or 2)
3689 : : !! nband(nkpt*nsppol) = number of bands at each k point, for each polarization
3690 : : !! npwarr(nkpt) = number of planewaves at each k point
3691 : : !! mpi_enreg <type(MPI_type)> = information about MPI parallelization
3692 : : !!
3693 : : !! OUTPUT
3694 : : !! (no output)
3695 : : !!
3696 : : !! SIDE EFFECTS
3697 : : !! wff <type(wffile_type)> =
3698 : : !!
3699 : : !! SOURCE
3700 : :
3701 : 0 : subroutine xdefineOff(formeig,wff,mpi_enreg,nband,npwarr,nspinor,nsppol,nkpt)
3702 : :
3703 : : !Arguments ------------------------------------
3704 : : integer, intent(in) :: nsppol,nkpt,nspinor,formeig
3705 : : integer, intent(in) :: nband(nkpt*nsppol),npwarr(nkpt)
3706 : : type(wffile_type),intent(inout) :: wff
3707 : : type(MPI_type),intent(in) :: mpi_enreg
3708 : :
3709 : : !Local variables-------------------------------
3710 : : #if defined HAVE_MPI_IO
3711 : : !scalars
3712 : : integer :: comm,iproc
3713 : : integer :: nband_k,npw_k,nproc,me,ipp
3714 : : integer :: nbrec,isppol,ikpt,nbint,nbreal,nbd,ippband
3715 : : integer :: nrecnpw,nreckg
3716 : : integer(kind=XMPI_OFFSET_KIND) :: pos_start
3717 : : !arrays
3718 : 0 : integer(kind=XMPI_OFFSET_KIND),allocatable :: offproc(:)
3719 : : #endif
3720 : :
3721 : : ! *************************************************************************
3722 : : !nbOct_int octet number of int value
3723 : : !nbOct_dp octet number of dp value
3724 : : !nbOct_ch octet number of character value
3725 : : !lght_recs length of record
3726 : :
3727 : : if(.false.)write(std_out,*)wff%me,mpi_enreg%nproc,formeig,nband,npwarr,nspinor,nkpt
3728 : : #if defined HAVE_MPI_IO
3729 [ # # ]: 0 : if(wff%iomode==IO_MODE_MPI)then
3730 : :
3731 : 0 : comm=mpi_enreg%comm_cell
3732 : 0 : me=xmpi_comm_rank(comm)
3733 : 0 : nproc=xmpi_comm_size(comm)
3734 : 0 : pos_start=wff%offwff
3735 : :
3736 [ # # # # : 0 : ABI_MALLOC(offproc,(0:nproc))
# # # # #
# # # ]
3737 [ # # ]: 0 : offproc = 0
3738 : : nbrec =2
3739 : : nrecnpw=3+nbrec
3740 : :
3741 [ # # ]: 0 : do isppol=1,nsppol
3742 [ # # ]: 0 : do ikpt=1,nkpt
3743 : 0 : nband_k=nband(ikpt+(isppol-1)*nkpt)
3744 : 0 : npw_k=npwarr(ikpt)
3745 : 0 : iproc=mpi_enreg%proc_distrb(ikpt,1,isppol)
3746 : : if (mpi_enreg%paralbd==1) iproc=mpi_enreg%proc_distrb(ikpt,1,isppol)
3747 : : ! record kg
3748 : 0 : nreckg=nbrec+ wff%kgwff*3*npw_k
3749 : :
3750 : : ! Record npw,nspinor,nband, Record kg
3751 : 0 : offproc(iproc) = offproc(iproc) + wff%nbOct_int*(nrecnpw+nreckg)
3752 : :
3753 [ # # ]: 0 : if (formeig == 0) then
3754 : : ! Records eigen,occ
3755 : 0 : nbint=nbrec
3756 : 0 : nbreal = 2 *nband_k
3757 : 0 : offproc(iproc) = offproc(iproc) + (wff%nbOct_int*nbint+wff%nbOct_dp*nbreal)
3758 : :
3759 : : ! Records cg
3760 : : offproc(iproc) = offproc(iproc) &
3761 : 0 : & + (wff%nbOct_int*nbrec+wff%nbOct_dp*2*npw_k*nspinor)*nband_k
3762 : :
3763 : 0 : ippband=iproc
3764 [ # # ]: 0 : do nbd=1,nband_k
3765 : 0 : ipp=mpi_enreg%proc_distrb(ikpt,nbd,isppol)
3766 [ # # ]: 0 : if (ipp /= ippband ) then
3767 : 0 : ippband=ipp
3768 : 0 : offproc(ippband)=offproc(ippband)+ wff%nbOct_int*(nrecnpw+nreckg)
3769 : : offproc(ippband) = offproc(ippband) + (wff%nbOct_int*nbint &
3770 : 0 : & +wff%nbOct_dp*nbreal)
3771 : : offproc(ippband) = offproc(ippband) + (wff%nbOct_int*nbrec &
3772 : 0 : & + wff%nbOct_dp*2*npw_k*nspinor)*nband_k
3773 : : end if
3774 : : end do
3775 [ # # ]: 0 : else if (formeig == 1) then
3776 : : ! record eigen
3777 : : offproc(iproc) = offproc(iproc) + (wff%nbOct_int*2*nbrec &
3778 : : & + wff%nbOct_dp*2*npw_k*nspinor &
3779 : 0 : & + wff%nbOct_dp*2*nband_k)*nband_k
3780 : 0 : ippband=iproc
3781 [ # # ]: 0 : do nbd=1,nband_k
3782 : 0 : ipp=mpi_enreg%proc_distrb(ikpt,nbd,isppol)
3783 [ # # ]: 0 : if (ipp /= ippband) then
3784 : 0 : ippband=ipp
3785 : 0 : offproc(ippband)=offproc(ippband)+ wff%nbOct_int*(nrecnpw+nreckg)
3786 : : offproc(ippband) = offproc(ippband) + (wff%nbOct_int*2*nbrec &
3787 : : & + wff%nbOct_dp*2*npw_k*nspinor &
3788 : 0 : & + wff%nbOct_dp*2*nband_k)*nband_k
3789 : : end if
3790 : : end do
3791 : : end if ! formeig
3792 : : end do ! ikpt
3793 : :
3794 : : end do ! isppol
3795 : :
3796 : : ! pos_start=wff%offwff
3797 : : ! wff%offwff = pos_start
3798 : :
3799 [ # # ]: 0 : if (me/=0)then
3800 [ # # ]: 0 : do iproc=0,me-1
3801 : 0 : wff%offwff=wff%offwff+offproc(iproc)
3802 : : end do
3803 : : end if
3804 [ # # ]: 0 : ABI_FREE(offproc)
3805 : :
3806 : : end if ! iomode
3807 : : #endif
3808 : :
3809 : 0 : end subroutine xdefineOff
3810 : : !!***
3811 : :
3812 : 0 : END MODULE m_wffile
3813 : : !!***
|
