TABLE OF CONTENTS


ABINIT/m_wffile [ Modules ]

[ Top ] [ Modules ]

NAME

  m_wffile

FUNCTION

  This module provides the definition of the wffile_type used to WF file data.
  As the type contains MPI-dependent fields, it has to be declared in a MPI-managed directory.

COPYRIGHT

 Copyright (C) 2009-2018 ABINIT group (MT,MB,MVer,ZL,MD)
 This file is distributed under the terms of the
 GNU General Public License, see ~abinit/COPYING
 or http://www.gnu.org/copyleft/gpl.txt .
 For the initials of contributors, see ~abinit/doc/developers/contributors.txt.

PARENTS

CHILDREN

NOTES

 wffile_type : a handler for dealing with the IO of a wavefunction file

SOURCE

26 #if defined HAVE_CONFIG_H
27 #include "config.h"
28 #endif
29 
30 #include "abi_common.h"
31 
32 MODULE m_wffile
33 
34  use defs_basis
35  use defs_abitypes
36  use m_errors
37  use m_abicore
38  use m_xmpi
39 #ifdef HAVE_MPI2
40  use mpi
41 #endif
42  use m_nctk
43 #ifdef HAVE_NETCDF
44  use netcdf
45 #endif
46 
47  use m_io_tools,   only : mvrecord, open_file
48  use m_fstrings,   only : toupper, endswith, sjoin
49 
50  implicit none
51 
52  private
53 
54 #ifdef HAVE_MPI1
55 include 'mpif.h'
56 #endif
57 
58 #define DEV_DEBUG_THIS 0
59 
60 !public procedures.
61  public :: WffOpen
62  public :: wffclose
63  public :: wffdelete
64  public :: wffkg
65  public :: wffoffset
66  public :: wffreaddatarec  !  Generic subroutines to read data in one record of a wavefunction file
67  public :: wffreadnpwrec
68  public :: wffreadskiprec
69  public :: wffreadwrite_mpio
70  public :: wffwritedatarec !  Generic subroutines to write data in one record of a wavefunction file
71  public :: wffwritenpwrec
72  public :: xderiveread     !  Generic subroutines to read wf files.
73  public :: xmpi_read_int2d
74  public :: xderivewrite
75 
76  public :: getRecordMarkerLength_wffile
77  public :: xnullifyOff
78  public :: xmoveOff
79  public :: xderiveWRecEnd
80  public :: xderiveWRecInit
81  public :: xderiveRRecEnd
82  public :: xderiveRRecInit
83 #if defined HAVE_MPI_IO
84  public :: rwRecordMarker
85 #endif
86  public :: clsopn
87  public :: wff_usef90
88  public :: xdefineOff

ABINIT/WffOffset [ Functions ]

[ Top ] [ Functions ]

NAME

 WffOffset

FUNCTION

 Tool to manage WF file in the MPI/IO case : broadcast the offset of
 the first k-point data block

INPUTS

  wff <type(wffile_type)> = structured info about the wavefunction file
  sender = id of the sender
  spaceComm = id of the space communicator handler

OUTPUT

  ier = error code returned by the MPI call

PARENTS

      m_iowf

CHILDREN

SOURCE

1506 subroutine WffOffset(wff,sender,spaceComm,ier)
1507 
1508 
1509 !This section has been created automatically by the script Abilint (TD).
1510 !Do not modify the following lines by hand.
1511 #undef ABI_FUNC
1512 #define ABI_FUNC 'WffOffset'
1513 !End of the abilint section
1514 
1515  implicit none
1516 
1517 !Arguments ------------------------------------
1518  type(wffile_type),intent(inout) :: wff
1519  integer          ,intent(inout) :: sender
1520  integer          ,intent(in)    :: spaceComm
1521  integer          ,intent(out)   :: ier
1522 
1523 !Local variables ------------------------------
1524 #if defined HAVE_MPI_IO
1525  integer :: icom
1526  integer(kind=MPI_OFFSET_KIND) :: ima
1527 #endif
1528 
1529 ! *********************************************************************
1530 
1531 #if defined HAVE_MPI_IO
1532  if (wff%iomode == IO_MODE_MPI) then
1533    call xmpi_max(sender,icom,spaceComm,ier)
1534    if (icom>=0)then
1535      ima=wff%offwff
1536      call MPI_BCAST(ima,1,wff%offset_mpi_type,icom,spaceComm,ier)
1537      wff%offwff=ima
1538    end if
1539  end if ! iomode
1540 #else
1541  ier = 0
1542  ABI_UNUSED((/wff%iomode,sender,spaceComm/))
1543 #endif
1544 
1545 end subroutine WffOffset

ABINIT/xderiveRead_dp1d [ Functions ]

[ Top ] [ Functions ]

NAME

  xderiveRead_dp1d

FUNCTION

  Generic routine to read/write wf files with MPI I/O.
  Target: one-dimensional double precision arrays.

INPUTS

  n1= first dimension of the array
  spaceComm= MPI communicator

OUTPUT

  ierr= exit status, a non-zero value meaning there is an error
  xval= data buffer array

SIDE EFFECTS

  wff= structured info for reading/writing the wavefunctions

PARENTS

CHILDREN

SOURCE

2853  subroutine xderiveRead_dp1d(wff,xval,n1,spaceComm,ierr)
2854 
2855 
2856 !This section has been created automatically by the script Abilint (TD).
2857 !Do not modify the following lines by hand.
2858 #undef ABI_FUNC
2859 #define ABI_FUNC 'xderiveRead_dp1d'
2860 !End of the abilint section
2861 
2862  implicit none
2863 
2864 !Arguments ------------------------------------
2865  type(wffile_type),intent(inout) :: wff
2866  integer,intent(in) :: n1,spaceComm
2867  integer,intent(out) :: ierr
2868  real(dp),intent(out) :: xval(:)
2869 
2870 !Local variables-------------------------------
2871 #if defined HAVE_MPI_IO
2872  integer(kind=MPI_OFFSET_KIND) :: delim_record,posit,nboct,dispoct,totoct
2873  integer :: statux(MPI_STATUS_SIZE)
2874 #endif
2875  character(len=500) :: msg
2876 
2877 !*********************************************************************
2878 
2879  xval(:)=zero ; ierr=0 ! Initialization, for the compiler
2880  if(.false.)write(std_out,*)wff%me,n1,spaceComm
2881 
2882 #if defined HAVE_MPI_IO
2883  nboct = wff%nbOct_dp * n1
2884  posit = wff%offwff
2885  delim_record = posit - wff%off_recs + wff%lght_recs - wff%nbOct_recMarker
2886 
2887  if (delim_record >= nboct) then
2888 !  Compute offset for local part
2889 !  dispoct = sum (nboct, rank=0..me)
2890    if (spaceComm/=MPI_COMM_SELF) then
2891      call MPI_SCAN(nboct,dispoct,1,wff%offset_mpi_type,MPI_SUM,spaceComm,ierr)
2892      posit = posit + dispoct - nboct
2893    end if
2894 
2895    call MPI_FILE_READ_AT(wff%fhwff,posit,xval,n1,MPI_DOUBLE_PRECISION,statux,ierr)
2896 
2897 !  get the total number of bits wrote by processors
2898    if (spaceComm/=MPI_COMM_SELF) then
2899      call xmpi_max(dispoct,totoct,spaceComm,ierr)
2900      !call MPI_ALLREDUCE(dispoct,totoct,1,wff%offset_mpi_type,MPI_MAX,spaceComm,ierr)
2901    else
2902      totoct=nboct
2903    end if
2904  else
2905    ierr = 1
2906    nboct =0
2907    totoct = 0
2908  end if
2909 
2910 !new offset
2911  wff%offwff=wff%offwff + totoct
2912  return
2913 #endif
2914 
2915  write(msg,'(a,i0,a)')' The value of wff%iomode=',wff%iomode,' is not allowed.'
2916  MSG_WARNING(msg)
2917 
2918 end subroutine xderiveRead_dp1d

m_wffile/clsopn [ Functions ]

[ Top ] [ m_wffile ] [ Functions ]

NAME

 clsopn

FUNCTION

 Close wavefunction file (provided its access is standard F90 IO), then reopen the same.
 Uses fortran inquire statement to reopen with same characteristics.

INPUTS

  wff=number of unit to which on which file is already opened.

SIDE EFFECTS

PARENTS

CHILDREN

SOURCE

 950 subroutine clsopn(wff)
 951 
 952 
 953 !This section has been created automatically by the script Abilint (TD).
 954 !Do not modify the following lines by hand.
 955 #undef ABI_FUNC
 956 #define ABI_FUNC 'clsopn'
 957 !End of the abilint section
 958 
 959  implicit none
 960 
 961 !Arguments ------------------------------------
 962 !scalars
 963  type(wffile_type),intent(inout) :: wff
 964 
 965 !Local variables-------------------------------
 966 !scalars
 967  integer :: ios,unit
 968  logical :: nmd,od
 969  character(len=11) :: fm
 970  character(len=500) :: message
 971  character(len=fnlen) :: filnam
 972 
 973 ! *************************************************************************
 974 
 975  if ( ANY(wff%iomode==(/IO_MODE_FORTRAN_MASTER,IO_MODE_FORTRAN/) ))then
 976 
 977    unit=wff%unwff
 978    inquire (unit=unit,iostat=ios,opened=od,name=filnam,form=fm,named=nmd)
 979 
 980 !  ios is a status specifier.  If an error condition exists,
 981 !  ios is assigned a processor-dependent value > 0.
 982    if (ios/=0) then
 983      write(message, '(/,a,/,a,i8,a,i8,/,a,/,a,/,a)' ) &
 984 &     ' clsopn : ERROR -',&
 985 &     '  Attempt to inquire about unit=',unit,&
 986 &     '  indicates error condition iostat=',ios,&
 987 &     '  May be due to temporary problem with file, disks or network.',&
 988 &     '  Action: check whether there might be some external problem,',&
 989 &     '  then resubmit.'
 990      MSG_ERROR(message)
 991 
 992 !    od is a logical variable which is set to true if the specified
 993 !    unit is connected to a file; otherwise it is set to false.
 994 #if !defined FC_HITACHI
 995    else if (.not.od) then
 996      write(message, '(/,a,/,a,i8,/,a,/,a,/,a,/,a)' ) &
 997 &     ' clsopn : ERROR -',&
 998 &     '  Tried to inquire about unit',unit,&
 999 &     '  and found it not connected to a file.',&
1000 &     '  May be due to temporary problem with file, disks or network.',&
1001 &     '  Action: check whether there might be some external problem,',&
1002 &     '  then resubmit.'
1003      MSG_ERROR(message)
1004 #endif
1005 
1006 !    nmd is a logical variable assigned the value true if the file
1007 !    has a name; otherwise false.  A scratch file is not named.
1008    else if (.not.nmd) then
1009 
1010 !    No action for the time being. Possibility to debug.
1011 
1012    else
1013 
1014 !    May now close the file and then reopen it
1015 !    (file is already opened according to above checks)
1016 
1017 #if defined FC_HITACHI
1018      if (.not.od) then
1019        write(message, '(a,i0,/,a,/,a,/,a)' ) &
1020 &       '  Tried to inquire about unit',unit,&
1021 &       '  and found it not connected to a file.',&
1022 &       '  May be due to temporary problem with file, disks or network.',&
1023 &       '  Action: disregard this error and continue the process anyway.'
1024        MSG_WARNING(message)
1025      end if
1026 #endif
1027      close (unit=unit)
1028      open (unit=unit,file=filnam,form=fm,status='old') !VALGRIND complains filnam is just a few thousand bytes inside a block of 8300
1029 
1030    end if
1031 
1032  else if (wff%iomode == IO_MODE_MPI) then
1033    call xnullifyOff(wff)
1034  else if (wff%iomode == IO_MODE_ETSF) then
1035 !  We do nothing, ETSF access already not being sequential.
1036  end if
1037 
1038 end subroutine clsopn

m_wffile/getRecordMarkerLength_wffile [ Functions ]

[ Top ] [ m_wffile ] [ Functions ]

NAME

  getRecordMarkerLength_wffile

FUNCTION

  Get the record marker length of the FORTRAN header of a file to access it in MPI/IO.
  This routine assumes that the header has been written (and flushed) in the file.

SIDE EFFECTS

  wff=<type(wffile_type)>=structured info for reading/writing the wavefunctions
      only%nbOct_recMarker is changed

PARENTS

      m_hdr

CHILDREN

SOURCE

251 subroutine getRecordMarkerLength_wffile(wff)
252 
253 
254 !This section has been created automatically by the script Abilint (TD).
255 !Do not modify the following lines by hand.
256 #undef ABI_FUNC
257 #define ABI_FUNC 'getRecordMarkerLength_wffile'
258 !End of the abilint section
259 
260  implicit none
261 
262 !Arguments ------------------------------------
263 !scalars
264  type(wffile_type),intent(inout) :: wff
265 
266 !Local variables-------------------------------
267 #if defined HAVE_MPI_IO
268 !scalars
269  integer :: headform,ierr,ii,iimax
270  integer(kind=MPI_OFFSET_KIND)  :: posit,rml
271  character(len=500) :: msg
272 !arrays
273  integer :: statux(MPI_STATUS_SIZE)
274 #endif
275 
276 !************************************************************************
277 
278 #ifdef DEV_DEBUG_THIS
279  return
280  ! Already done in WffOpen
281 #endif
282 
283 #if defined HAVE_MPI_IO
284 
285  if (wff%nbOct_recMarker>0) return
286 
287 !wff%nbOct_recMarker=4;return
288 !call flush(wff%unwff)
289 !call MPI_FILE_SYNC(wff%fhwff,ierr)
290 
291 !Only master do that
292  ierr=0
293  if (wff%master==wff%me) then
294 
295 ! Define number of INTEGER types to be tested
296 #if defined HAVE_FC_INT_QUAD
297    iimax=4
298 #else
299    iimax=3
300 #endif
301 
302 ! Try to read headform
303    rml=-1;ii=0
304    do while (wff%nbOct_recMarker<=0.and.ii<iimax)
305      ii=ii+1
306      if (ii==1) rml=4
307      if (ii==2) rml=8
308      if (ii==3) rml=2
309      if (ii==4) rml=16
310      posit=rml+6*wff%nbOct_ch
311      call MPI_FILE_READ_AT(wff%fhwff,posit,headform,1,MPI_INTEGER,statux,ierr)
312      if (ierr==MPI_SUCCESS) then
313        if (headform==wff%headform) wff%nbOct_recMarker=rml
314      end if
315     end do
316 
317     if (ierr/=MPI_SUCCESS) then
318      MSG_BUG("Header problem")
319     end if
320 
321    if (ii==iimax.and.wff%nbOct_recMarker<=0) then
322 !      if (iimax>=4) then
323 !        write(msg,'(3a)') &
324 ! &        ' Your architecture is not able to handle 16, 8, 4 or 2-bytes FORTRAN file record markers !',ch10,&
325 ! &        ' You cannot use ABINIT and MPI/IO.'
326 !      else
327 !        write(msg,'(3a)') &
328 ! &        '  Your architecture is not able to handle 8, 4 or 2-bytes FORTRAN file record markers !',ch10,&
329 ! &        '  You cannot use ABINIT and MPI/IO.'
330 !      end if
331      write(msg,'(13a)') &
332 &      ' Error during FORTRAN file record marker detection:',ch10,&
333 &      ' It was not possible to read/write a small file!',ch10,&
334 &      ' ACTION: check your access permissions to the file system.',ch10,&
335 &      ' Common sources of this problem:',ch10,&
336 &      '  - Quota limit exceeded,',ch10,&
337 &      '  - R/W incorrect permissions,',ch10,&
338 &      '  - WFK file requested as input (irdwfk=1/getwfk=1) but not existing ...'
339      MSG_ERROR(msg)
340    else
341      write(msg,'(a,i0)') &
342 &     '  MPI/IO accessing FORTRAN file header: detected record mark length=',wff%nbOct_recMarker
343      MSG_COMMENT(msg)
344    end if
345 
346  end if  ! me=master
347 
348 !Broadcast record marker length
349  if (wff%spaceComm/=MPI_COMM_SELF) then
350    call MPI_BCAST(wff%nbOct_recMarker,1,wff%offset_mpi_type,wff%master,wff%spaceComm,ierr)
351  end if
352 
353 !Select MPI datatype for markers
354  if (wff%nbOct_recMarker==4) then
355    wff%marker_mpi_type=MPI_INTEGER4
356  else if (wff%nbOct_recMarker==8) then
357    wff%marker_mpi_type=MPI_INTEGER8
358 #if defined HAVE_FC_INT_QUAD && defined HAVE_MPI_INTEGER16
359  else if (wff%nbOct_recMarker==16) then
360    wff%marker_mpi_type=MPI_INTEGER16
361 #endif
362  else if (wff%nbOct_recMarker==2) then
363    wff%marker_mpi_type=MPI_INTEGER2
364  end if
365 
366 #endif
367 
368  RETURN
369  ABI_UNUSED(wff%me)
370 
371 end subroutine getRecordMarkerLength_wffile

m_wffile/rwRecordMarker [ Functions ]

[ Top ] [ m_wffile ] [ Functions ]

NAME

  rwRecordMarker

FUNCTION

  Read/Write a record marker in a FORTRAN file at a given file pointer position.
  This is needed to access data in a FORTRAN file with MPI/IO.

INPUTS

  option=1 for reading by current proc
         2 for writing by current proc
         3 for reading by all procs
         4 for writing by all procs
  posit= position of the MPI/IO file pointer
  wff=<type(wffile_type)>=structured info for reading/writing
     Use here only:
       wff%fhwff= handle of the MPI/IO file
       wff%nbOct_recMarker= length of Fortran record markers

OUTPUT

  ierr= error code

SIDE EFFECTS

  posit= position of the MPI/IO file pointer
         updated after the reading (with the length of the record)
  recordmarker= content of the record marker

PARENTS

      m_hdr,m_wffile

CHILDREN

SOURCE

410 #if defined HAVE_MPI_IO
411 
412 subroutine rwRecordMarker(option,posit,recordmarker,wff,ierr)
413 
414 
415 !This section has been created automatically by the script Abilint (TD).
416 !Do not modify the following lines by hand.
417 #undef ABI_FUNC
418 #define ABI_FUNC 'rwRecordMarker'
419 !End of the abilint section
420 
421  implicit none
422 
423 !Arguments ------------------------------------
424 !scalars
425  integer,intent(in) :: option
426  integer(kind=MPI_OFFSET_KIND),intent(inout) :: posit,recordmarker
427  integer,intent(out) :: ierr
428  type(wffile_type),intent(inout) :: wff
429 
430 !Local variables-------------------------------
431 !scalars
432  integer(kind=2)  :: delim_record2(1)
433  integer(kind=4)  :: delim_record4(1)
434  integer(kind=8)  :: delim_record8(1)
435 #if defined HAVE_FC_INT_QUAD
436  integer(kind=16) :: delim_record16(1)
437 #endif
438 !character(len=500) :: msg
439 !arrays
440  integer  :: statux(MPI_STATUS_SIZE)
441 
442 !************************************************************************
443 
444  ierr=0
445 
446  if (option==1) then
447    if (wff%nbOct_recMarker==4) then
448      call MPI_FILE_READ_AT(wff%fhwff,posit,delim_record4 ,1,wff%marker_mpi_type,statux,ierr)
449      recordmarker = delim_record4(1)
450    else if (wff%nbOct_recMarker==8) then
451      call MPI_FILE_READ_AT(wff%fhwff,posit,delim_record8 ,1,wff%marker_mpi_type,statux,ierr)
452      recordmarker = delim_record8(1)
453 #if defined HAVE_FC_INT_QUAD
454    else if (wff%nbOct_recMarker==16) then
455      call MPI_FILE_READ_AT(wff%fhwff,posit,delim_record16,1,wff%marker_mpi_type,statux,ierr)
456      recordmarker = delim_record16(1)
457 #endif
458    else if (wff%nbOct_recMarker==2) then
459      call MPI_FILE_READ_AT(wff%fhwff,posit,delim_record2 ,1,wff%marker_mpi_type,statux,ierr)
460      recordmarker = delim_record2(1)
461    else
462      MSG_BUG('Wrong record marker length!')
463    end if
464 
465  else if (option==2) then
466    if (wff%nbOct_recMarker==4) then
467      delim_record4 = recordmarker
468      call MPI_FILE_WRITE_AT(wff%fhwff,posit,delim_record4 ,1,wff%marker_mpi_type,statux,ierr)
469    else if (wff%nbOct_recMarker==8) then
470      delim_record8 = recordmarker
471      call MPI_FILE_WRITE_AT(wff%fhwff,posit,delim_record8 ,1,wff%marker_mpi_type,statux,ierr)
472 #if defined HAVE_FC_INT_QUAD
473    else if (wff%nbOct_recMarker==16) then
474      delim_record16 = recordmarker
475      call MPI_FILE_WRITE_AT(wff%fhwff,posit,delim_record16,1,wff%marker_mpi_type,statux,ierr)
476 #endif
477    else if (wff%nbOct_recMarker==2) then
478      delim_record2 = recordmarker
479      call MPI_FILE_WRITE_AT(wff%fhwff,posit,delim_record2 ,1,wff%marker_mpi_type,statux,ierr)
480    else
481      MSG_BUG('Wrong record marker length!')
482    end if
483 
484  else if (option==3) then
485    if (wff%nbOct_recMarker==4) then
486      call MPI_FILE_READ_AT_ALL(wff%fhwff,posit,delim_record4 ,1,wff%marker_mpi_type,statux,ierr)
487      recordmarker = delim_record4(1)
488    else if (wff%nbOct_recMarker==8) then
489      call MPI_FILE_READ_AT_ALL(wff%fhwff,posit,delim_record8 ,1,wff%marker_mpi_type,statux,ierr)
490      recordmarker = delim_record8(1)
491 #if defined HAVE_FC_INT_QUAD
492    else if (wff%nbOct_recMarker==16) then
493      call MPI_FILE_READ_AT_ALL(wff%fhwff,posit,delim_record16,1,wff%marker_mpi_type,statux,ierr)
494      recordmarker = delim_record16(1)
495 #endif
496    else if (wff%nbOct_recMarker==2) then
497      call MPI_FILE_READ_AT_ALL(wff%fhwff,posit,delim_record2 ,1,wff%marker_mpi_type,statux,ierr)
498      recordmarker = delim_record2(1)
499    else
500      MSG_BUG('Wrong record marker length !')
501    end if
502 
503  else if (option==4) then
504    if (wff%nbOct_recMarker==4) then
505      delim_record4 = recordmarker
506      call MPI_FILE_WRITE_AT_ALL(wff%fhwff,posit,delim_record4 ,1,wff%marker_mpi_type,statux,ierr)
507    else if (wff%nbOct_recMarker==8) then
508      delim_record8 = recordmarker
509      call MPI_FILE_WRITE_AT_ALL(wff%fhwff,posit,delim_record8 ,1,wff%marker_mpi_type,statux,ierr)
510 #if defined HAVE_FC_INT_QUAD
511    else if (wff%nbOct_recMarker==16) then
512      delim_record16 = recordmarker
513      call MPI_FILE_WRITE_AT_ALL(wff%fhwff,posit,delim_record16,1,wff%marker_mpi_type,statux,ierr)
514 #endif
515    else if (wff%nbOct_recMarker==2) then
516      delim_record2 = recordmarker
517      call MPI_FILE_WRITE_AT_ALL(wff%fhwff,posit,delim_record2 ,1,wff%marker_mpi_type,statux,ierr)
518    else
519      MSG_BUG('Wrong record marker length!')
520    end if
521 
522  else
523    MSG_BUG('Wrong value for option!')
524  end if
525 
526  posit = posit + recordmarker + 2*wff%nbOct_recMarker
527 
528 end subroutine rwRecordMarker
529 #endif

m_wffile/wff_ireadf90 [ Functions ]

[ Top ] [ m_wffile ] [ Functions ]

NAME

 wff_ireadf90

FUNCTION

  1 if a Fortran file is going to be read by this node, 0 otherwise.

INPUTS

PARENTS

CHILDREN

SOURCE

1099 function wff_ireadf90(wff)
1100 
1101 
1102 !This section has been created automatically by the script Abilint (TD).
1103 !Do not modify the following lines by hand.
1104 #undef ABI_FUNC
1105 #define ABI_FUNC 'wff_ireadf90'
1106 !End of the abilint section
1107 
1108  implicit none
1109 
1110 !Arguments ------------------------------------
1111 !scalars
1112  integer :: wff_ireadf90
1113  type(wffile_type),intent(in) :: wff
1114 
1115 ! *************************************************************************
1116 
1117  wff_ireadf90=0
1118  if (wff%iomode==IO_MODE_FORTRAN.or.(wff%iomode==IO_MODE_FORTRAN_MASTER.and.wff%master==wff%me)) wff_ireadf90=1
1119 
1120 end function wff_ireadf90

m_wffile/wff_usef90 [ Functions ]

[ Top ] [ m_wffile ] [ Functions ]

NAME

 wff_usef90

FUNCTION

  1 if a Fortran file is going to be read by this node, 0 otherwise.

INPUTS

PARENTS

CHILDREN

SOURCE

1058 function wff_usef90(wff)
1059 
1060 
1061 !This section has been created automatically by the script Abilint (TD).
1062 !Do not modify the following lines by hand.
1063 #undef ABI_FUNC
1064 #define ABI_FUNC 'wff_usef90'
1065 !End of the abilint section
1066 
1067  implicit none
1068 
1069 !Arguments ------------------------------------
1070 !scalars
1071  integer :: wff_usef90
1072  type(wffile_type),intent(in) :: wff
1073 
1074 ! *************************************************************************
1075 
1076  wff_usef90=0
1077  if (wff%iomode==IO_MODE_FORTRAN.or.(wff%iomode ==IO_MODE_FORTRAN_MASTER.and.wff%master==wff%me)) wff_usef90=1
1078 
1079 end function wff_usef90

m_wffile/WffClose [ Functions ]

[ Top ] [ m_wffile ] [ Functions ]

NAME

 WffClose

FUNCTION

 This subroutine closes a Wf file.

INPUTS

 wff= structured info about the wavefunction file

OUTPUT

 ierr=error code

PARENTS

      conducti_paw,conducti_paw_core,dfpt_looppert,dfptnl_loop,emispec_paw
      gstate,m_ioarr,m_iowf,m_wfk,nonlinear,optics_paw,optics_paw_core
      optics_vloc,posdoppler,respfn,uderiv

CHILDREN

SOURCE

1322 subroutine WffClose(wff,ier)
1323 
1324 
1325 !This section has been created automatically by the script Abilint (TD).
1326 !Do not modify the following lines by hand.
1327 #undef ABI_FUNC
1328 #define ABI_FUNC 'WffClose'
1329 !End of the abilint section
1330 
1331  implicit none
1332 
1333 !Arguments ------------------------------------
1334  type(wffile_type), intent(inout) :: wff
1335  integer, intent(out) :: ier
1336 
1337 !Local ------------------------------------
1338 
1339 ! *************************************************************************
1340 
1341  ier=0
1342  if(wff%iomode==IO_MODE_FORTRAN) then ! All processors see a local file
1343    close(unit=wff%unwff)
1344 
1345 #ifdef HAVE_NETCDF
1346  else if(wff%iomode == IO_MODE_ETSF)then
1347    NCF_CHECK(nf90_close(wff%unwff))
1348 #endif
1349 
1350  else if(wff%iomode==IO_MODE_FORTRAN_MASTER)then !  Only the master processor see a local file
1351    if(wff%master==wff%me) close (unit=wff%unwff)    ! VALGRIND complains buf points to uninitialized bytes
1352 
1353 #if defined HAVE_MPI_IO
1354  else if(wff%iomode==IO_MODE_MPI)then
1355    call MPI_FILE_CLOSE(wff%fhwff,ier)
1356    if (wff%master==wff%me ) close(unit=wff%unwff)
1357    wff%offwff=0;wff%off_recs=0;wff%lght_recs=0
1358    wff%nbOct_recMarker=-1
1359    wff%kgwff=-1
1360 #endif
1361 
1362  end if
1363 
1364 end subroutine WffClose

m_wffile/WffDelete [ Functions ]

[ Top ] [ m_wffile ] [ Functions ]

NAME

 WffDelete

FUNCTION

 This subroutine closes a Wf file, and delete it.

INPUTS

 wff= structured info about the wavefunction file

OUTPUT

 ierr=error code

PARENTS

CHILDREN

SOURCE

1388 subroutine WffDelete(wff,ier)
1389 
1390 
1391 !This section has been created automatically by the script Abilint (TD).
1392 !Do not modify the following lines by hand.
1393 #undef ABI_FUNC
1394 #define ABI_FUNC 'WffDelete'
1395 !End of the abilint section
1396 
1397  implicit none
1398 
1399 !Arguments ------------------------------------
1400  type(wffile_type),intent(inout) :: wff
1401  integer, intent(out) :: ier
1402 
1403 !Local variables-------------------------------
1404 
1405 ! *************************************************************************
1406 
1407  ier=0
1408  if (wff%iomode==IO_MODE_FORTRAN) then !  All processors see a local file
1409    close(unit=wff%unwff,status='delete')
1410 
1411  else if (wff%iomode==IO_MODE_FORTRAN_MASTER)then !  Only the master processor see a local file
1412    if (wff%master==wff%me) close (unit=wff%unwff,status='delete')
1413 
1414 
1415  else if (wff%iomode==IO_MODE_MPI)then
1416 #if defined HAVE_MPI_IO
1417    if ( wff%fhwff /= -1 )then
1418      call MPI_FILE_CLOSE(wff%fhwff,ier)
1419    end if
1420    if (wff%master==wff%me ) then
1421      close(unit=wff%unwff,status='delete')
1422      wff%fhwff = -1
1423    end if
1424    wff%offwff=0;wff%off_recs=0;wff%lght_recs=0
1425    wff%nbOct_recMarker=-1
1426    wff%kgwff=-1
1427 #endif
1428  end if
1429 
1430 end subroutine WffDelete

m_wffile/wffile_type [ Types ]

[ Top ] [ m_wffile ] [ Types ]

NAME

 wffile_type

FUNCTION

 This structure datatype is a handler for dealing with the IO of a
 wavefunction file.
 It contains, among other things, the method of access to the file
 (standard F90 read/write, or NetCDF call, or MPI IO), the unit number
 if applicable, the filename, the information on the
 parallelism, etc ...

SOURCE

146  type, public :: wffile_type
147 
148 ! WARNING : if you modify this datatype, please check there there is no creation/destruction/copy routine,
149 ! declared in another part of ABINIT, that might need to take into account your modification.
150 
151 ! Integer scalar
152   integer :: unwff
153    ! unwff  unit number of unformatted wavefunction disk file
154 
155   integer :: iomode
156    ! Method to access the wavefunction file
157    !   IO_MODE_FORTRAN for usual Fortran IO routines
158    !   IO_MODE_FORTRAN_MASTER if usual Fortran IO routines, but only the master node in the parallel case
159    !   IO_MODE_MPI if MPI/IO routines (this access method is only available in parallel)
160    !   IO_MODE_NETCDF if NetCDF routines (obsolete, do not use)
161    !   IO_MODE_ETSF, NetCDF format read via etsf-io.
162 
163   integer :: formwff
164    ! formwff=format of the eigenvalues
165    !   -1 => not used
166    !    0 => vector of eigenvalues
167    !    1 => hermitian matrix of eigenvalues
168 
169   integer :: headform
170    ! headform=format of the header
171 
172   integer ::  kgwff
173    ! kgwff  if 1 , read or write kg_k ; if 0, do not care about kg_k
174 
175 ! Character
176   character(len=fnlen) :: fname
177    ! filename (if available)
178 
179 ! In case of MPI parallel use
180   integer :: master
181    ! index of the processor master of the IO procedure when the WffOpen call is issued
182 
183   integer :: me
184    ! index of my processor in the spaceComm communicator
185 
186   integer :: me_mpiio
187    ! index of my processor in the spaceComm_mpiio communicator
188 
189   integer :: nproc
190    ! number of processors that will have access to the file
191 
192   integer :: spaceComm
193    ! space communicator for the standard FORTRAN access to the file
194 
195   integer :: spaceComm_mpiio
196    ! space communicator for the MPI/IO access to the file
197 
198 ! In case of MPI/IO : additional information
199   integer :: fhwff
200    ! file handle used to access the file with MPI/IO.
201 
202   integer(kind=XMPI_OFFSET_KIND) :: nbOct_int,nbOct_dp,nbOct_ch
203    ! nbOct_int byte number of int value
204    ! nbOct_dp  byte number of dp value
205    ! nbOct_ch  byte number of character value
206 
207   integer(kind=XMPI_OFFSET_KIND) :: nbOct_recMarker
208    ! byte number of Fortran file record markers
209 
210   integer(kind=XMPI_OFFSET_KIND) :: lght_recs
211    ! length of record
212 
213   integer :: marker_mpi_type
214    ! MPI Datatype for Fortran record markers
215 
216   integer(kind=XMPI_OFFSET_KIND)  :: offwff,off_recs
217    ! offwff   offset position of unformatted wavefunction disk file
218    ! off_recs offset position of start record
219    ! (used in parallel MPI-IO)
220 
221   integer :: offset_mpi_type
222    ! MPI Datatype for INTEGER(kind=MPI_OFFSET_KIND)
223 
224  end type wffile_type
225 
226 
227 CONTAINS

m_wffile/WffKg [ Functions ]

[ Top ] [ m_wffile ] [ Functions ]

NAME

 WffKg

FUNCTION

 Check kgwff to  manage WF file in the MPI/IO case

INPUTS

  wff <type(wffile_type)> = structured info about the wavefunction file
  optkg= if 1 , read or write kg_k ; if 0,do not care about kg_k in rwwf

OUTPUT

PARENTS

      m_iowf,m_wfk

CHILDREN

SOURCE

1455 subroutine WffKg(wff,optkg)
1456 
1457 
1458 !This section has been created automatically by the script Abilint (TD).
1459 !Do not modify the following lines by hand.
1460 #undef ABI_FUNC
1461 #define ABI_FUNC 'WffKg'
1462 !End of the abilint section
1463 
1464  implicit none
1465 
1466 !Arguments ------------------------------------
1467  type(wffile_type),intent(inout) :: wff
1468  integer,intent(in) :: optkg
1469 
1470 ! *********************************************************************
1471 
1472 #if defined HAVE_MPI_IO
1473  if (wff%iomode == IO_MODE_MPI) wff%kgwff=optkg
1474 #else
1475  ABI_UNUSED((/wff%iomode,optkg/))
1476 #endif
1477 
1478 end subroutine WffKg

m_wffile/WffOpen [ Functions ]

[ Top ] [ m_wffile ] [ Functions ]

NAME

 WffOpen

FUNCTION

 This subroutine opens a Wf file. It might be accessed
 by different mechanisms (usual F90 IO routines,
  MPI I/O, or, in the future, NetCDF). The routine
 provides a file handler, wff (a data structure containing
 all needed information).

INPUTS

 iomode=access mode (0 means all procs access using usual F90
  routines ; -1 means only the master proc access, using usual
  F90 routines ; 1 means MPI I/O; 2 means netcdf I/O)
 filename=name of the file
 master=the number of the master proc (only needed in parallel)
 me=my number (only needed in parallel)
 spaceComm= the space communicator handler (only needed in MPI parallel I/O)
 spaceWorld= the space communicator for the whole set of procs
 unwff=the file unit number

OUTPUT

 ier=error code
 wff= structured info about the wavefunction file

PARENTS

      conducti_paw,conducti_paw_core,emispec_paw,inwffil,linear_optics_paw
      m_ioarr,m_iowf,m_wfk,optics_paw,optics_paw_core,optics_vloc,posdoppler
      uderiv

CHILDREN

SOURCE

1160 subroutine WffOpen(iomode,spaceComm,filename,ier,wff,master,me,unwff,&
1161 &                  spaceComm_mpiio) ! optional argument
1162 
1163 
1164 !This section has been created automatically by the script Abilint (TD).
1165 !Do not modify the following lines by hand.
1166 #undef ABI_FUNC
1167 #define ABI_FUNC 'WffOpen'
1168 !End of the abilint section
1169 
1170  implicit none
1171 
1172 !Arguments ------------------------------------
1173  integer, intent(in)  :: iomode,spaceComm,master,me,unwff
1174  integer, intent(in),optional  :: spaceComm_mpiio
1175  integer, intent(out) :: ier
1176  character(len=fnlen), intent(in) :: filename
1177  type(wffile_type), intent(inout) :: wff !vz_i
1178 
1179 !Local variables-------------------------------
1180  character(len=500) :: message
1181  character(len=fnlen) :: fildata
1182 #ifdef HAVE_MPI_IO
1183  integer :: isize
1184 #endif
1185 
1186 ! *************************************************************************
1187 
1188 !Initialize the mandatory data of the wff datastructure
1189  wff%unwff  =unwff
1190  wff%iomode =iomode; if (endswith(filename, ".nc")) wff%iomode = IO_MODE_ETSF
1191  if (filename/=wff%fname) wff%fname=filename
1192 
1193 !Initialize info useful for parallel use
1194  wff%nproc    =1
1195  wff%master   =master
1196  wff%me       =me
1197  wff%me_mpiio =0
1198  wff%spaceComm=spaceComm
1199  wff%spaceComm_mpiio=xmpi_comm_self
1200 
1201 #if defined HAVE_MPI
1202 ! This case occurs when wff is connected to a DENSITY file
1203 ! abinit_comm_output is generally equal to MPI_COMM_WORLD (except if paral. over images)
1204   if (spaceComm==MPI_COMM_SELF) wff%spaceComm=abinit_comm_output
1205 ! if (spaceComm==MPI_COMM_SELF) wff%spaceComm=MPI_COMM_WORLD
1206   call MPI_COMM_SIZE(wff%spaceComm,wff%nproc,ier)
1207 ! Redefine the default MPIIO communicator if MPI, although MPIIO features should not be used unless
1208 ! present(spaceComm_mpiio).and.wff%iomode==1
1209   wff%spaceComm_mpiio=wff%spaceComm
1210   wff%me_mpiio=wff%me
1211 #endif
1212 
1213   if (present(spaceComm_mpiio).and.any(wff%iomode==[IO_MODE_MPI, IO_MODE_ETSF])) wff%spaceComm_mpiio=spaceComm_mpiio
1214 #if defined HAVE_MPI
1215   call MPI_COMM_RANK(wff%spaceComm_mpiio,wff%me_mpiio,ier)
1216 #endif
1217 
1218  ier=0
1219  if (wff%iomode==IO_MODE_FORTRAN) then !  All processors see a local file
1220    if (open_file(filename, message, unit=unwff, form="unformatted") /= 0) then
1221      MSG_ERROR(message)
1222    end if
1223    rewind(unwff)
1224 
1225  else if (wff%iomode==IO_MODE_FORTRAN_MASTER) then !  Only the master processor see a local file
1226    if(master==me)then
1227      if (open_file(filename, message, unit=unwff, form="unformatted") /= 0) then
1228        MSG_ERROR(message)
1229      end if
1230      rewind(unwff)
1231    end if
1232 
1233 #if defined HAVE_MPI_IO
1234  else if (wff%iomode==IO_MODE_MPI)then ! In the parallel case, only the master open filename file
1235    if(master==me)then
1236      if (open_file(filename, message, unit=unwff, form="unformatted") /= 0) then
1237        MSG_ERROR(message)
1238      end if
1239      rewind(unwff)
1240    end if
1241    ! MG: Great! These barriers lead to a deadlock if prtded hence MPI_FILE_OPEN is not called by all the processors!
1242    !call xmpi_barrier(wff%spaceComm)
1243    !call xmpi_barrier(wff%spaceComm_mpiio)
1244 
1245    call MPI_FILE_OPEN(wff%spaceComm,filename,MPI_MODE_CREATE + MPI_MODE_RDWR,MPI_INFO_NULL,wff%fhwff,ier)
1246    ABI_CHECK_MPI(ier,sjoin("WffOpen:", filename))
1247 
1248 !  Define all type values
1249    call MPI_Type_size(MPI_INTEGER,isize,ier)
1250    wff%nbOct_int=isize
1251    call MPI_Type_size(MPI_DOUBLE_PRECISION,isize,ier)
1252    wff%nbOct_dp=isize
1253    call MPI_Type_size(MPI_CHARACTER,isize,ier)
1254    wff%nbOct_ch=isize
1255    wff%nbOct_recMarker=-1;wff%kgwff=-1;wff%formwff=-1
1256    wff%offwff=0;wff%off_recs=0;wff%lght_recs=0
1257    wff%marker_mpi_type=MPI_INTEGER ! Default value
1258 
1259 #ifdef DEV_DEBUG_THIS
1260    wff%nbOct_recMarker=xmpio_bsize_frm
1261    wff%marker_mpi_type=xmpio_mpi_type_frm
1262 #endif
1263 
1264    if (MPI_OFFSET_KIND==4) then
1265      wff%offset_mpi_type=MPI_INTEGER4
1266    else  if (MPI_OFFSET_KIND==8) then
1267      wff%offset_mpi_type=MPI_INTEGER8
1268 #if defined HAVE_FC_INT_QUAD && defined HAVE_MPI_INTEGER16
1269    else  if (MPI_OFFSET_KIND==16) then
1270      wff%offset_mpi_type=MPI_INTEGER16
1271 #endif
1272    else  if (MPI_OFFSET_KIND==2) then
1273      wff%offset_mpi_type=MPI_INTEGER2
1274    end if
1275 #endif
1276 
1277 #ifdef HAVE_NETCDF
1278  else if (wff%iomode==IO_MODE_ETSF)then
1279    fildata = nctk_ncify(filename)
1280    NCF_CHECK(nctk_open_modify(wff%unwff, fildata, xmpi_comm_self))
1281    wff%fname = fildata
1282    !write(message,'(3A,I0)')'WffOpen: opening ', trim(wff%fname)," on unit ", wff%unwff
1283    !call wrtout(std_out, message, 'COLL')
1284 #endif
1285  else
1286    write(message, '(7a,i0,3a)' )&
1287 &   'For the time being the input variable iomode is restricted ',ch10,&
1288 &   'to 0 (all cases), 1 (in case MPI is enabled),',ch10,&
1289 &   'or 3 (only sequential, and if the NetCDF and ETSF_IO libraries have been enabled).',ch10,&
1290 &   'Its value is iomode= ',wff%iomode,'.',ch10,&
1291 &   'Action: change iomode or use ABINIT in parallel or enable NetCDF and/or ETSF_IO.'
1292    MSG_ERROR(message)
1293  end if
1294 
1295 end subroutine WffOpen

m_wffile/WffReadDataRec_dp1d [ Functions ]

[ Top ] [ m_wffile ] [ Functions ]

NAME

 WffReadDataRec_dp1d

FUNCTION

 Subroutine to read data in one record of a wavefunction file
 Handles double precision 1D arrays

INPUTS

 ndp=size of the double precision array to be read
 wff= structured info about the wavefunction file

OUTPUT

 dparray=array of double precision numbers
 ierr=error code

SIDE EFFECTS

PARENTS

CHILDREN

SOURCE

1574 subroutine WffReadDataRec_dp1d(dparray,ierr,ndp,wff)
1575 
1576 
1577 !This section has been created automatically by the script Abilint (TD).
1578 !Do not modify the following lines by hand.
1579 #undef ABI_FUNC
1580 #define ABI_FUNC 'WffReadDataRec_dp1d'
1581 !End of the abilint section
1582 
1583  implicit none
1584 
1585 !Arguments ------------------------------------
1586  type(wffile_type),intent(inout) :: wff
1587  integer,intent(in) ::  ndp
1588  integer,intent(out) :: ierr
1589  real(dp),intent(out) :: dparray(ndp)
1590 
1591 !Local variables-------------------------------
1592  character(len=500) :: msg
1593 
1594 ! *************************************************************************
1595 
1596  ierr=0
1597  if (wff%iomode==IO_MODE_FORTRAN.or.(wff%iomode==IO_MODE_FORTRAN_MASTER.and.wff%master==wff%me)) then
1598    read (wff%unwff,iostat=ierr) dparray(1:ndp)
1599 
1600  else if(wff%iomode==IO_MODE_MPI)then
1601 #if defined HAVE_MPI_IO
1602    call xderiveRRecInit(wff,ierr)
1603    call xderiveRead(wff,dparray,ndp,MPI_COMM_SELF,ierr)
1604    call xderiveRRecEnd(wff,ierr)
1605 #endif
1606  else
1607    write(msg,'(a,i0)')"Wrong iomode: ",wff%iomode
1608    MSG_ERROR(msg)
1609  end if
1610 
1611 end subroutine WffReadDataRec_dp1d

m_wffile/WffReadDataRec_dp2d [ Functions ]

[ Top ] [ m_wffile ] [ Functions ]

NAME

 WffReadDataRec_dp2d

FUNCTION

 Subroutine to read data in one record of a wavefunction file
 Handles double precision 2D arrays

INPUTS

 n1,n2=sizes of the double precision array to be read
 wff= structured info about the wavefunction file

OUTPUT

 dparray=array of double precision numbers
 ierr=error code

SIDE EFFECTS

PARENTS

CHILDREN

SOURCE

1641 subroutine WffReadDataRec_dp2d(dparray,ierr,n1,n2,wff)
1642 
1643 
1644 !This section has been created automatically by the script Abilint (TD).
1645 !Do not modify the following lines by hand.
1646 #undef ABI_FUNC
1647 #define ABI_FUNC 'WffReadDataRec_dp2d'
1648 !End of the abilint section
1649 
1650  implicit none
1651 
1652 !Arguments ------------------------------------
1653  type(wffile_type),intent(inout) :: wff
1654  integer,intent(in) ::  n1,n2
1655  integer,intent(out) :: ierr
1656  real(dp),intent(out) :: dparray(n1,n2)
1657 
1658 !Local variables-------------------------------
1659  character(len=500) :: msg
1660 
1661 ! *************************************************************************
1662 
1663  ierr=0
1664  if (wff%iomode==IO_MODE_FORTRAN.or.(wff%iomode==IO_MODE_FORTRAN_MASTER.and.wff%master==wff%me)) then
1665    read (wff%unwff,iostat=ierr) dparray(1:n1,1:n2)
1666 
1667  else if(wff%iomode==IO_MODE_MPI)then
1668 #if defined HAVE_MPI_IO
1669    call xderiveRRecInit(wff,ierr)
1670    call xderiveRead(wff,dparray,n1,n2,MPI_COMM_SELF,ierr)
1671    call xderiveRRecEnd(wff,ierr)
1672 #endif
1673  else
1674    write(msg,'(a,i0)')"Wrong iomode: ",wff%iomode
1675    MSG_ERROR(msg)
1676  end if
1677 
1678 end subroutine WffReadDataRec_dp2d

m_wffile/WffReadNpwRec [ Functions ]

[ Top ] [ m_wffile ] [ Functions ]

NAME

 WffReadNpwRec

FUNCTION

 This subroutine read the npw record of a wavefunction file

INPUTS

 wff= structured info about the wavefunction file
  wff%access == -1 and wf%master == Wff%me:
     read binary data
  wff%iomode == 0:
     read binary data
  wff%iomode == 1:
     use MPI/IO routines (MPIO defined)
  wff%iomode == 2:
     read netcdf format (NETCDF defined)
 ikpt= the i-th kpoint.
 isppol= the given spin polarisation element.

OUTPUT

 ierr=error code (iostat integer from read statement)
 nband_disk=number of bands
 npw=number of plane waves
 nspinor=number of spinorial components of the wavefunctions

SIDE EFFECTS

PARENTS

      rwwf

CHILDREN

SOURCE

1718 subroutine WffReadNpwRec(ierr,ikpt,isppol,nband_disk,npw,nspinor,wff)
1719 
1720 
1721 !This section has been created automatically by the script Abilint (TD).
1722 !Do not modify the following lines by hand.
1723 #undef ABI_FUNC
1724 #define ABI_FUNC 'WffReadNpwRec'
1725 !End of the abilint section
1726 
1727  implicit none
1728 
1729 !Arguments ------------------------------------
1730  type(wffile_type),intent(inout) :: wff
1731  integer,intent(in)  :: ikpt, isppol
1732  integer,intent(out) :: ierr,nband_disk,npw,nspinor
1733 
1734 !Local variables-------------------------------
1735  !character(len=500) :: msg
1736 #if defined HAVE_NETCDF
1737  integer :: vid
1738 #endif
1739 
1740 ! *************************************************************************
1741 
1742  ierr=0
1743 
1744  if (wff%iomode == IO_MODE_FORTRAN.or.(wff%iomode==IO_MODE_FORTRAN_MASTER.and.wff%master==wff%me) ) then
1745    read (wff%unwff,iostat=ierr) npw,nspinor,nband_disk
1746 
1747  else if(wff%iomode==IO_MODE_MPI)then
1748 #if defined HAVE_MPI_IO
1749    call xderiveRRecInit(wff,ierr)
1750    call xderiveRead(wff,npw,ierr)
1751    call xderiveRead(wff,nspinor,ierr)
1752    call xderiveRead(wff,nband_disk,ierr)
1753    call xderiveRRecEnd(wff,ierr)
1754 #endif
1755 
1756  else if (wff%iomode == IO_MODE_ETSF) then
1757 
1758 #if defined HAVE_NETCDF
1759    !write(std_out,*)"readnpwrec: ikpt, spin", ikpt, spin
1760    NCF_CHECK(nctk_get_dim(wff%unwff, "number_of_spinor_components", nspinor))
1761    vid = nctk_idname(wff%unwff, "number_of_coefficients")
1762    NCF_CHECK(nf90_get_var(wff%unwff, vid, npw, start=[ikpt]))
1763    vid = nctk_idname(wff%unwff, "number_of_states")
1764    NCF_CHECK(nf90_get_var(wff%unwff, vid, nband_disk, start=[ikpt, isppol]))
1765 #endif
1766 
1767  else
1768    ! MG: I don't understand why we have to use this ugly code!!!!!!!!
1769    ! Only master knows npw,nspinor,nband_disk in IO_MODE_FORTRAN_MASTE mode
1770    ! To the person who wrote this stuff:
1771    ! Have you ever heard about the "IF" statement of Fortran and the typical construct
1772    !
1773    !      if (rank==master) call mpifoo_seq()
1774 
1775    MSG_WARNING("Skipping read in WffReadNpwRec. Keep fingers crossed")
1776    ! MG: Must initialze these values somehow to avoid overflows.
1777    npw = 0; nspinor = 0; nband_disk = 0
1778  end if
1779 
1780  !write(std_out,*)"nband_disk,npw,nspinor",nband_disk,npw,nspinor
1781  ABI_CHECK(ierr==0,"ierr!=0")
1782 
1783 end subroutine WffReadNpwRec

m_wffile/WffReadSkipRec [ Functions ]

[ Top ] [ m_wffile ] [ Functions ]

NAME

 WffReadSkipRec

FUNCTION

 This subroutine move forward or backward in a Wf file by nrec records.

INPUTS

 nrec=number of records
 wff= structured info about the wavefunction file

OUTPUT

 ierr=error code

TODO

 For the future : one should treat the possible errors of backspace

PARENTS

      gstate,randac,rwwf

CHILDREN

SOURCE

1813 subroutine WffReadSkipRec(ierr,nrec,wff)
1814 
1815 
1816 !This section has been created automatically by the script Abilint (TD).
1817 !Do not modify the following lines by hand.
1818 #undef ABI_FUNC
1819 #define ABI_FUNC 'WffReadSkipRec'
1820 !End of the abilint section
1821 
1822  implicit none
1823 
1824 !Arguments ------------------------------------
1825  integer,intent(in)  :: nrec
1826  integer,intent(out) :: ierr
1827  type(wffile_type),intent(inout) :: wff
1828 
1829 !Local variables-------------------------------
1830 #if defined HAVE_MPI_IO
1831  integer :: irec
1832  integer(kind=MPI_OFFSET_KIND) :: delim_record,offset
1833 #endif
1834 
1835 ! *************************************************************************
1836 
1837  ierr=0
1838  if( wff%iomode==IO_MODE_FORTRAN.or.(wff%iomode==IO_MODE_FORTRAN_MASTER.and.wff%master==wff%me)) then
1839 
1840    call mvrecord(wff%unwff,nrec,ierr)
1841    ABI_CHECK(ierr==0,"error in mvrecord")
1842 
1843 
1844  else if(wff%iomode==IO_MODE_MPI)then
1845 #if defined HAVE_MPI_IO
1846    if (nrec>0) then ! Move forward nrec records
1847      do irec=1,nrec
1848        wff%off_recs = wff%offwff
1849        call rwRecordMarker(1,wff%offwff,delim_record,wff,ierr)
1850        wff%lght_recs = delim_record
1851      end do
1852    else             ! Move backward -nrec records
1853      do irec=1,-nrec
1854        offset = wff%offwff-wff%nbOct_recMarker
1855        call rwRecordMarker(1,offset,delim_record,wff,ierr)
1856        wff%lght_recs = delim_record
1857        wff%offwff = wff%offwff - delim_record - 2*wff%nbOct_recMarker
1858        wff%off_recs = wff%offwff
1859      end do
1860    end if
1861 #endif
1862  end if ! wff%iomode==0,1 or -1
1863 
1864 end subroutine WffReadSkipRec

m_wffile/WffReadWrite_mpio [ Functions ]

[ Top ] [ m_wffile ] [ Functions ]

NAME

 WffReadWrite_mpio

FUNCTION

  This procedure read or write cg in the file _WFK using MPI_IO
  when cg are dispatched amoung commcart communicator

INPUTS

  wff=struct info for wavefunction
  nband_disk=number of bands on disk files to be write
  icg=shift to be given to the location of the cg array
  mcg=second dimention of cg
  mpi_enreg=information about parallelisation
  depl_mpi_to_seq=for each proc, index of cg in sequential mode
  npwso=npw*nspinor number of plane waves treated by this node.
  npwsotot=npwtot*nspinor Total number of planewaves Used to calculate the size of data to be written.
  rdwr=1 if reading, 2 if writing

OUTPUT

  ierr=error status

SIDE EFFECTS

  cg(2,mcg)=planewave coefficients of wavefunctions,

NOTES

  cg is written like the following:
    BeginMarker cg ( iband = 1 )  EndMarker
    BeginMarker cg ( iband = 2 )  EndMarker
    ...
    BeginMarker cg( iband = nband_disk ) EndMarker

  BeginMarker and EndMarker give the value of the total length of cg for one band

  For MPI-IO library the performance is improved by the use a "view" of the file for each proc.

PARENTS

      rwwf

CHILDREN

SOURCE

1912 subroutine WffReadWrite_mpio(wff,rdwr,cg,mcg,icg,nband_disk,npwso,npwsotot,depl_mpi_to_seq,ierr)
1913 
1914 
1915 !This section has been created automatically by the script Abilint (TD).
1916 !Do not modify the following lines by hand.
1917 #undef ABI_FUNC
1918 #define ABI_FUNC 'WffReadWrite_mpio'
1919 !End of the abilint section
1920 
1921  implicit none
1922 
1923 !Arguments ------------------------------------
1924 !scalars
1925  integer,intent(in) :: icg,mcg,nband_disk,npwso,npwsotot,rdwr
1926  integer,intent(out) :: ierr
1927  type(wffile_type),intent(inout) :: wff
1928 !arrays
1929  integer,intent(in) :: depl_mpi_to_seq(npwso)
1930  real(dp),intent(inout) :: cg(2,mcg)
1931 
1932 !Local variables-------------------------------
1933 !scalars
1934 #if defined HAVE_MPI_IO
1935  integer,parameter :: MAXBAND=500, check_markers=1
1936  integer :: filetype,iband,ibandmax,ibandmin,iblock,ii,iloc,ipw,jerr,jj
1937  integer :: nb,nband_block,step,totsize1bandcg,wfftempo
1938  integer(kind=MPI_OFFSET_KIND) :: delim_record,loc_depl_band,offset,totsize1bandByte
1939  character(len=500) :: msg
1940 !arrays
1941  integer,allocatable :: BlockLength(:),BlockType(:),map(:),tempo_map(:)
1942  integer(kind=MPI_OFFSET_KIND),allocatable :: BlockDepl(:)
1943  integer(kind=2),allocatable :: bufdelim2(:)
1944  integer(kind=4),allocatable :: bufdelim4(:)
1945  integer(kind=8),allocatable :: bufdelim8(:)
1946  real(dp),allocatable :: buf(:),tempo_buf(:)
1947 #if defined HAVE_FC_INT_QUAD
1948  integer(kind=16),allocatable :: bufdelim16(:)
1949 #endif
1950 #endif
1951 
1952 ! *********************************************************************
1953 
1954  ierr=0
1955 
1956 #if defined HAVE_MPI_IO
1957 !----------------------------------------------
1958 !! Prepare WF data
1959 !----------------------------------------------
1960 !Init offset of record
1961  wff%off_recs = wff%offwff
1962 
1963 !Total size to be written (in number of bands and in bytes)
1964  totsize1bandcg=2*npwsotot
1965 !call xmpi_sum(totsize1bandcg,wff%spaceComm_mpiio,ierr)
1966 
1967  totsize1bandByte=totsize1bandcg*wff%nbOct_dp+2*wff%nbOct_recMarker
1968 
1969 !Check file size
1970  offset=wff%offwff+nband_disk*totsize1bandByte
1971  if (offset>Huge(offset)) then
1972    msg='File is too large for MPI-IO specifications !'
1973    MSG_ERROR(msg)
1974  end if
1975 
1976 !Open file
1977  call MPI_FILE_OPEN(wff%spaceComm_mpiio,wff%fname,MPI_MODE_RDWR,MPI_INFO_NULL,wfftempo,ierr)
1978  ABI_CHECK_MPI(ierr, sjoin("MPI_FILE_OPEN:", wff%fname))
1979 
1980 !----------------------------------------------------------
1981 !Loop blocks of bands (to decrease offsets inside the file)
1982 !----------------------------------------------------------
1983  ibandmax=0;ibandmin=1
1984  ii=huge(check_markers)/totsize1bandByte;step=min(ii,MAXBAND,nband_disk)
1985  do iblock=1,nband_disk/step+1
1986    ibandmax=min(ibandmin+step-1,nband_disk)
1987    nband_block=ibandmax-ibandmin+1
1988    offset=wff%offwff+(ibandmin-1)*totsize1bandByte
1989 
1990 !  ----------------------------------------------
1991 !  Read/Write bands
1992 !  ----------------------------------------------
1993 
1994 !  Build map; for better performance, map must be in increasing order
1995    ABI_STAT_ALLOCATE(map,(2*npwso*nband_block), ierr)
1996    ABI_CHECK(ierr==0, "out of memory in map")
1997 
1998    ABI_STAT_ALLOCATE(buf,(2*npwso*nband_block), ierr)
1999    msg = "out of memory in wavefunction buffer. Try to decrease MAXBAND in WffReadWrite_mpio"
2000    ABI_CHECK(ierr==0, msg)
2001 
2002    if (rdwr==1) then
2003 !    If reading, only build map
2004      nb=0;loc_depl_band=0
2005      ABI_ALLOCATE(tempo_map,(2*npwso))
2006      do iband=ibandmin,ibandmax
2007        tempo_map(1:2*npwso)=-1
2008        jj=1;ipw=(iband-1)*npwso+icg
2009        do ii=1,npwso
2010          iloc=loc_depl_band+wff%nbOct_recMarker+2*(depl_mpi_to_seq(ii)-1)*wff%nbOct_dp
2011          tempo_map(jj  )=iloc              ! Real part
2012          tempo_map(jj+1)=iloc+wff%nbOct_dp ! Imag part
2013          jj=jj+2
2014        end do
2015        do ii=1,2*npwso ! Now, elimate holes
2016          if (tempo_map(ii)/=-1) then
2017            nb=nb+1
2018            map(nb)=tempo_map(ii)
2019          end if
2020        end do
2021        loc_depl_band=loc_depl_band+totsize1bandByte ! Location in bytes
2022      end do
2023    else if (rdwr==2) then
2024 !    If writing, build map and store cg in a buffer
2025      nb=0;loc_depl_band=0
2026      ABI_ALLOCATE(tempo_map,(2*npwso))
2027      ABI_ALLOCATE(tempo_buf,(2*npwso))
2028      do iband=ibandmin,ibandmax
2029        tempo_map(1:2*npwso)=-1
2030        jj=1;ipw=(iband-1)*npwso+icg
2031        do ii=1,npwso
2032          iloc=loc_depl_band+wff%nbOct_recMarker+2*(depl_mpi_to_seq(ii)-1)*wff%nbOct_dp
2033          tempo_map(jj  )=iloc              ! Real part
2034          tempo_map(jj+1)=iloc+wff%nbOct_dp ! Imag part
2035          tempo_buf(jj:jj+1)=cg(1:2,ipw+ii)
2036          jj=jj+2
2037        end do
2038        do ii=1,2*npwso ! Now, elimate holes
2039          if (tempo_map(ii)/=-1) then
2040            nb=nb+1
2041            map(nb)=tempo_map(ii)
2042            buf(nb)=tempo_buf(ii)
2043          end if
2044        end do
2045        loc_depl_band=loc_depl_band+totsize1bandByte ! Location in bytes
2046      end do
2047      ABI_DEALLOCATE(tempo_map)
2048      ABI_DEALLOCATE(tempo_buf)
2049    end if  ! rdwr
2050 
2051 !  Build and commit MPI datatype
2052    ABI_ALLOCATE(BlockLength,(nb+2))
2053    ABI_ALLOCATE(BlockDepl,(nb+2))
2054    ABI_ALLOCATE(BlockType,(nb+2))
2055    BlockLength(1)=1;BlockDepl(1)=0;BlockType(1)=MPI_LB
2056    do ii=2,nb+1
2057      BlockLength(ii)=1
2058      BlockDepl(ii)=map(ii-1)
2059      BlockType(ii)=MPI_DOUBLE_PRECISION
2060    end do
2061    BlockLength(nb+2)=1;BlockDepl(nb+2)=totsize1bandByte*nband_block;BlockType(nb+2)=MPI_UB
2062    call xmpio_type_struct(nb+2,BlockLength,BlockDepl,BlockType,filetype,ierr)
2063    call MPI_TYPE_COMMIT(filetype,ierr)
2064    ABI_DEALLOCATE(BlockLength)
2065    ABI_DEALLOCATE(BlockDepl)
2066    ABI_DEALLOCATE(BlockType)
2067 
2068 !  Read/Write data on disk
2069    call MPI_FILE_SET_VIEW(wfftempo,offset,MPI_BYTE,filetype,"native",MPI_INFO_NULL,ierr)
2070    if (rdwr==1) then
2071      call MPI_FILE_READ_ALL (wfftempo,buf,nb,MPI_DOUBLE_PRECISION,MPI_STATUS_IGNORE,ierr)
2072    else
2073      call MPI_FILE_WRITE_ALL(wfftempo,buf,nb,MPI_DOUBLE_PRECISION,MPI_STATUS_IGNORE,ierr)
2074    end if
2075 
2076 !  In case of reading, retrieve cg
2077    if (rdwr==1) then
2078      nb=0;loc_depl_band=0
2079      ABI_ALLOCATE(tempo_buf,(2*npwso))
2080      do iband=ibandmin,ibandmax
2081        do ii=1,2*npwso ! Now, elimate holes
2082          if (tempo_map(ii)/=-1) then
2083            nb=nb+1;tempo_buf(ii)=buf(nb)
2084          end if
2085        end do
2086        jj=1;ipw=(iband-1)*npwso+icg
2087        do ii=1,npwso
2088          iloc=loc_depl_band+wff%nbOct_recMarker+2*(depl_mpi_to_seq(ii)-1)*wff%nbOct_dp
2089          cg(1:2,ipw+ii)=tempo_buf(jj:jj+1)
2090          jj=jj+2
2091        end do
2092        loc_depl_band=loc_depl_band+totsize1bandByte ! Location in bytes
2093      end do
2094      ABI_DEALLOCATE(tempo_map)
2095      ABI_DEALLOCATE(tempo_buf)
2096    end if ! rdwr
2097 
2098 !  Free memory
2099    ABI_DEALLOCATE(map)
2100    ABI_DEALLOCATE(buf)
2101    call MPI_TYPE_FREE(filetype,ierr)
2102 
2103 !  ----------------------------------------------
2104 !  Check/Write record markers (only master proc)
2105 !  ----------------------------------------------
2106    if ((rdwr==1.and.check_markers==1).or.(rdwr==2)) then
2107 
2108 !    Define view for the file
2109      nb=2*nband_block
2110      ABI_ALLOCATE(BlockLength,(nb+2))
2111      ABI_ALLOCATE(BlockDepl,(nb+2))
2112      ABI_ALLOCATE(BlockType,(nb+2))
2113      BlockLength(1)=1;BlockDepl(1)=0;BlockType(1)=MPI_LB
2114      jj=2
2115      do ii=1,nband_block
2116        BlockType(jj:jj+1)  =wff%marker_mpi_type
2117        BlockLength(jj:jj+1)=1
2118        BlockDepl(jj  )=(ii-1)*totsize1bandByte
2119        BlockDepl(jj+1)= ii   *totsize1bandByte-wff%nbOct_recMarker
2120        jj=jj+2
2121      end do
2122      BlockLength(nb+2)=1;BlockDepl(nb+2)=nband_block*totsize1bandByte;BlockType(nb+2)=MPI_UB
2123      call xmpio_type_struct(nb+2,BlockLength,BlockDepl,BlockType,filetype,ierr)
2124      call MPI_TYPE_COMMIT(filetype,ierr)
2125      call MPI_FILE_SET_VIEW(wfftempo,offset,MPI_BYTE,filetype,"native",MPI_INFO_NULL,ierr)
2126      ABI_DEALLOCATE(BlockLength)
2127      ABI_DEALLOCATE(BlockDepl)
2128      ABI_DEALLOCATE(BlockType)
2129 
2130 !    Read/Write all markers (depend on Fortran marker MPI type)
2131      if (wff%me_mpiio==0) then
2132        jerr=0;delim_record=totsize1bandByte-2*wff%nbOct_recMarker
2133        if (wff%nbOct_recMarker==4) then
2134          ABI_ALLOCATE(bufdelim4,(nb))
2135          if (rdwr==2) bufdelim4(:)=delim_record
2136          if (rdwr==1) then
2137            call MPI_FILE_READ (wfftempo,bufdelim4,2*nband_block,wff%marker_mpi_type,MPI_STATUS_IGNORE,ierr)
2138            if (any(bufdelim4(:)/=delim_record)) jerr=1
2139          else
2140            call MPI_FILE_WRITE(wfftempo,bufdelim4,2*nband_block,wff%marker_mpi_type,MPI_STATUS_IGNORE,ierr)
2141          end if
2142          ABI_DEALLOCATE(bufdelim4)
2143        else if (wff%nbOct_recMarker==8) then
2144          ABI_ALLOCATE(bufdelim8,(nb))
2145          if (rdwr==2) bufdelim8(:)=delim_record
2146          if (rdwr==1) then
2147            call MPI_FILE_READ (wfftempo,bufdelim8,2*nband_block,wff%marker_mpi_type,MPI_STATUS_IGNORE,ierr)
2148            if (any(bufdelim8(:)/=delim_record)) jerr=1
2149          else
2150            call MPI_FILE_WRITE(wfftempo,bufdelim8,2*nband_block,wff%marker_mpi_type,MPI_STATUS_IGNORE,ierr)
2151          end if
2152          ABI_DEALLOCATE(bufdelim8)
2153 #if defined HAVE_FC_INT_QUAD
2154        else if (wff%nbOct_recMarker==16) then
2155          ABI_ALLOCATE(bufdelim16,(nb))
2156          if (rdwr==2) bufdelim16(:)=delim_record
2157          if (rdwr==1) then
2158            call MPI_FILE_READ (wfftempo,bufdelim16,2*nband_block,wff%marker_mpi_type,MPI_STATUS_IGNORE,ierr)
2159            if (any(bufdelim16(:)/=delim_record)) jerr=1
2160          else
2161            call MPI_FILE_WRITE(wfftempo,bufdelim16,2*nband_block,wff%marker_mpi_type,MPI_STATUS_IGNORE,ierr)
2162          end if
2163          ABI_DEALLOCATE(bufdelim16)
2164 #endif
2165        else if (wff%nbOct_recMarker==2) then
2166          ABI_ALLOCATE(bufdelim2,(nb))
2167          if (rdwr==2) bufdelim2(:)=delim_record
2168          if (rdwr==1) then
2169            call MPI_FILE_READ (wfftempo,bufdelim2,2*nband_block,wff%marker_mpi_type,MPI_STATUS_IGNORE,ierr)
2170            if (any(bufdelim2(:)/=delim_record)) jerr=1
2171          else
2172            call MPI_FILE_WRITE(wfftempo,bufdelim2,2*nband_block,wff%marker_mpi_type,MPI_STATUS_IGNORE,ierr)
2173          end if
2174          ABI_DEALLOCATE(bufdelim2)
2175        end if
2176        if (rdwr==1.and.jerr==1) then
2177          write(unit=msg,fmt='(2a)') 'Error when reading record markers of file ',trim(wff%fname)
2178          MSG_ERROR(msg)
2179        end if
2180      end if  ! me_mpiio=0
2181 
2182 !    Free memory
2183      call MPI_TYPE_FREE(filetype,ierr)
2184 
2185    end if ! rdwr
2186 
2187 !  -----------------------------------------
2188 !  End loop on blocks of bands
2189 !  -----------------------------------------
2190    if (ibandmax>=nband_disk) exit
2191    ibandmin=ibandmax+1
2192  end do
2193 
2194 !-----------------------------------------
2195 !End statements
2196 !-----------------------------------------
2197 !Close file
2198  call MPI_FILE_CLOSE(wfftempo,ierr)
2199 
2200 !Update offset
2201  wff%offwff=wff%offwff+totsize1bandByte*nband_disk
2202 #endif
2203 
2204 #if !defined HAVE_MPI_IO
2205 !Dummy check to avoid warning from compilers.
2206  ABI_UNUSED((/wff%iomode,rdwr,size(cg),mcg,icg,nband_disk,npwso,depl_mpi_to_seq(1),npwsotot/))
2207 #endif
2208 
2209 end subroutine WffReadWrite_mpio

m_wffile/WffWriteDataRec_dp1d [ Functions ]

[ Top ] [ m_wffile ] [ Functions ]

NAME

 WffWriteDataRec_dp1d

FUNCTION

 Subroutine to write data in one record of a wavefunction file
 Handles double precision 1D arrays

INPUTS

 dparray=array of double precision numbers
 ndp=size of the double precision array to be written
 wff= structured info about the wavefunction file

OUTPUT

 ierr=error code

SIDE EFFECTS

PARENTS

CHILDREN

SOURCE

2305 subroutine WffWriteDataRec_dp1d(dparray,ierr,ndp,wff)
2306 
2307 
2308 !This section has been created automatically by the script Abilint (TD).
2309 !Do not modify the following lines by hand.
2310 #undef ABI_FUNC
2311 #define ABI_FUNC 'WffWriteDataRec_dp1d'
2312 !End of the abilint section
2313 
2314  implicit none
2315 
2316 !Arguments ------------------------------------
2317  type(wffile_type),intent(inout) :: wff
2318  integer,intent(in) ::  ndp
2319  integer,intent(out) :: ierr
2320  real(dp),intent(in) :: dparray(ndp)
2321 
2322 !Local variables-------------------------------
2323  character(len=500) :: msg
2324 
2325 ! *************************************************************************
2326 
2327  ierr=0
2328  if (wff%iomode==IO_MODE_FORTRAN.or.(wff%iomode==IO_MODE_FORTRAN_MASTER.and.wff%master==wff%me)) then
2329    write(wff%unwff,iostat=ierr) dparray(1:ndp)
2330 
2331  else if(wff%iomode==IO_MODE_MPI)then
2332 #if defined HAVE_MPI_IO
2333    call xderiveWRecInit(wff,ierr)
2334    call xderiveWrite(wff,dparray,ndp,MPI_COMM_SELF,ierr)
2335    call xderiveWRecEnd(wff,ierr)
2336 #endif
2337  else
2338    write(msg,'(a,i0,a)')' The value of wff%iomode=',wff%iomode,' is not allowed.'
2339    MSG_WARNING(msg)
2340  end if
2341 
2342 end subroutine WffWriteDataRec_dp1d

m_wffile/WffWriteDataRec_dp2d [ Functions ]

[ Top ] [ m_wffile ] [ Functions ]

NAME

 WffWriteDataRec_dp2d

FUNCTION

 Subroutine to write data in one record of a wavefunction file
 Handles double precision 2D arrays

INPUTS

 dparray=array of double precision numbers
 n1,n2=sizes of the double precision array to be written
 wff= structured info about the wavefunction file

OUTPUT

 ierr=error code

SIDE EFFECTS

PARENTS

CHILDREN

SOURCE

2373 subroutine WffWriteDataRec_dp2d(dparray,ierr,n1,n2,wff)
2374 
2375 
2376 !This section has been created automatically by the script Abilint (TD).
2377 !Do not modify the following lines by hand.
2378 #undef ABI_FUNC
2379 #define ABI_FUNC 'WffWriteDataRec_dp2d'
2380 !End of the abilint section
2381 
2382  implicit none
2383 
2384 !Arguments ------------------------------------
2385  type(wffile_type),intent(inout) :: wff
2386  integer,intent(in) ::  n1,n2
2387  integer,intent(out) :: ierr
2388  real(dp),intent(in) :: dparray(n1,n2)
2389 
2390 !Local variables-------------------------------
2391  character(len=500) :: msg
2392 
2393 ! *************************************************************************
2394 
2395  ierr=0
2396  if (wff%iomode==IO_MODE_FORTRAN.or.(wff%iomode==IO_MODE_FORTRAN_MASTER.and.wff%master==wff%me)) then
2397    write(wff%unwff,iostat=ierr) dparray(1:n1,1:n2)
2398 
2399  else if(wff%iomode==IO_MODE_MPI)then
2400 #if defined HAVE_MPI_IO
2401    call xderiveWRecInit(wff,ierr)
2402    call xderiveWrite(wff,dparray,n1,n2,MPI_COMM_SELF,ierr)
2403    call xderiveWRecEnd(wff,ierr)
2404 #endif
2405  else
2406    write(msg,'(a,i0,a)')' The value of wff%iomode=',wff%iomode,' is not allowed.'
2407    MSG_WARNING(msg)
2408  end if
2409 
2410 end subroutine WffWriteDataRec_dp2d

m_wffile/WffWriteDataRec_int2d [ Functions ]

[ Top ] [ m_wffile ] [ Functions ]

NAME

 WffWriteDataRec_int2d

FUNCTION

 Subroutine to write data in one record of a wavefunction file
 Handles integer 2D arrays

INPUTS

 intarray=array of integer numbers
 n1,n2=sizes of the integer array to be written
 wff= structured info about the wavefunction file

OUTPUT

 ierr=error code

SIDE EFFECTS

PARENTS

CHILDREN

SOURCE

2238 subroutine WffWriteDataRec_int2d(intarray,ierr,n1,n2,wff)
2239 
2240 
2241 !This section has been created automatically by the script Abilint (TD).
2242 !Do not modify the following lines by hand.
2243 #undef ABI_FUNC
2244 #define ABI_FUNC 'WffWriteDataRec_int2d'
2245 !End of the abilint section
2246 
2247  implicit none
2248 
2249 !Arguments ------------------------------------
2250  type(wffile_type),intent(inout) :: wff
2251  integer,intent(in) ::  n1,n2
2252  integer,intent(out) :: ierr
2253  integer,intent(in) :: intarray(n1,n2)
2254 
2255 !Local variables-------------------------------
2256  character(len=500) :: msg
2257 
2258 ! *************************************************************************
2259 
2260  ierr=0
2261  if (wff%iomode==IO_MODE_FORTRAN.or.(wff%iomode==IO_MODE_FORTRAN_MASTER.and.wff%master==wff%me)) then
2262    write(wff%unwff,iostat=ierr) intarray(1:n1,1:n2)
2263 
2264  else if(wff%iomode==IO_MODE_MPI)then
2265 #if defined HAVE_MPI_IO
2266    call xderiveWRecInit(wff,ierr)
2267    call xderiveWrite(wff,intarray,n1,n2,MPI_COMM_SELF,ierr)
2268    call xderiveWRecEnd(wff,ierr)
2269 #endif
2270  else
2271    write(msg,'(a,i0,a)')' The value of wff%iomode=',wff%iomode,' is not allowed.'
2272    MSG_WARNING(msg)
2273  end if
2274 
2275 end subroutine WffWriteDataRec_int2d

m_wffile/WffWriteNpwRec [ Functions ]

[ Top ] [ m_wffile ] [ Functions ]

NAME

 WffWriteNpwRec

FUNCTION

 This subroutine writes the npw record of a wavefunction file

INPUTS

 wff= structured info about the wavefunction file
 nband_disk=number of bands
 npw=number of plane waves
 nspinor=number of spinorial components of the wavefunctions
 opt_paral=(optional argument, default=1, only used for MPI-IO)
           1: all procs in the communicator write the data
           2: only master in the communicator writes the data

OUTPUT

 ierr=error code

SIDE EFFECTS

PARENTS

      rwwf

CHILDREN

SOURCE

2445 subroutine WffWriteNpwRec(ierr,nband_disk,npw,nspinor,wff,&
2446 &                         opt_paral) ! optional argument
2447 
2448 
2449 !This section has been created automatically by the script Abilint (TD).
2450 !Do not modify the following lines by hand.
2451 #undef ABI_FUNC
2452 #define ABI_FUNC 'WffWriteNpwRec'
2453 !End of the abilint section
2454 
2455  implicit none
2456 
2457 !Arguments ------------------------------------
2458  type(wffile_type),intent(inout) :: wff
2459  integer,intent(in) :: nband_disk,npw,nspinor
2460  integer,intent(in),optional :: opt_paral
2461  integer,intent(out) :: ierr
2462 
2463 !Local variables-------------------------------
2464  integer :: opt_paral_
2465 #if defined HAVE_MPI_IO
2466  integer :: me
2467 #endif
2468  character(len=500) :: msg
2469 
2470 ! *************************************************************************
2471 
2472  ierr=0
2473  opt_paral_=1;if (present(opt_paral)) opt_paral_=opt_paral
2474 
2475  if (wff%iomode==IO_MODE_FORTRAN.or.(wff%iomode ==IO_MODE_FORTRAN_MASTER.and.wff%master==wff%me)) then
2476    write(wff%unwff,iostat=ierr) npw,nspinor,nband_disk
2477 
2478  else if(wff%iomode==IO_MODE_MPI)then
2479 #if defined HAVE_MPI_IO
2480    me=-1;if (opt_paral_==2) me=wff%me_mpiio
2481    if ((me==-1.and.opt_paral_==1).or.(me==0.and.opt_paral_==2)) then
2482      call xderiveWRecInit(wff,ierr)
2483      call xderiveWrite(wff,npw,ierr)
2484      call xderiveWrite(wff,nspinor,ierr)
2485      call xderiveWrite(wff,nband_disk,ierr)
2486      call xderiveWRecEnd(wff,ierr)
2487    end if
2488    if (opt_paral_==2.and.wff%spaceComm_mpiio/=MPI_COMM_SELF) then
2489      call xmpi_barrier(wff%spaceComm_mpiio)
2490      call MPI_BCAST(wff%offwff,1,wff%offset_mpi_type,0,wff%spaceComm_mpiio,ierr)
2491    end if
2492 #endif
2493  else
2494    write(msg,'(a,i0,a)')' The value of wff%iomode=',wff%iomode,' is not allowed.'
2495    MSG_WARNING(msg)
2496  end if
2497 
2498 end subroutine WffWriteNpwRec

m_wffile/xdefineOff [ Functions ]

[ Top ] [ m_wffile ] [ Functions ]

NAME

  xdefineOff

FUNCTION

  In case of MPI I/O, defines the offset for each processor

INPUTS

  formeig option (format of the eigenvalues and occupations) :
   0 => ground-state format (initialisation of eigenvectors with
        random numbers, vector of eigenvalues, occupations are present)
   1 => respfn format (initialisation of eigenvectors with 0 s,
        hermitian matrix of eigenvalues)
  nkpt = number of k points
  nspinor = total number of spinorial components of the wavefunctions
  nsppol = number of channels for spin-polarization (1 or 2)
  nband(nkpt*nsppol) = number of bands at each k point, for each polarization
  npwarr(nkpt) = number of planewaves at each k point
  mpi_enreg <type(MPI_type)> = information about MPI parallelization

OUTPUT

  (no output)

SIDE EFFECTS

  wff <type(wffile_type)> =

PARENTS

      uderiv

CHILDREN

SOURCE

4313 subroutine xdefineOff(formeig,wff,mpi_enreg,nband,npwarr,nspinor,nsppol,nkpt)
4314 
4315 
4316 !This section has been created automatically by the script Abilint (TD).
4317 !Do not modify the following lines by hand.
4318 #undef ABI_FUNC
4319 #define ABI_FUNC 'xdefineOff'
4320 !End of the abilint section
4321 
4322  implicit none
4323 
4324 !Arguments ------------------------------------
4325  integer, intent(in) ::  nsppol,nkpt,nspinor,formeig
4326  integer, intent(in) ::  nband(nkpt*nsppol),npwarr(nkpt)
4327  type(wffile_type),intent(inout) :: wff
4328  type(MPI_type),intent(in) :: mpi_enreg
4329 
4330 !Local variables-------------------------------
4331 #if defined HAVE_MPI_IO
4332 !scalars
4333  integer :: comm,iproc
4334  integer :: nband_k,npw_k,nproc,me,ipp
4335  integer :: nbrec,isppol,ikpt,nbint,nbreal,nbd,ippband
4336  integer :: nrecnpw,nreckg
4337  integer(kind=XMPI_OFFSET_KIND) :: pos_start
4338 !arrays
4339  integer(kind=XMPI_OFFSET_KIND),allocatable  :: offproc(:)
4340 #endif
4341 
4342 ! *************************************************************************
4343 !nbOct_int octet number of int value
4344 !nbOct_dp octet number of dp value
4345 !nbOct_ch octet number of character value
4346 !lght_recs length of record
4347 
4348  if(.false.)write(std_out,*)wff%me,mpi_enreg%nproc,formeig,nband,npwarr,nspinor,nkpt
4349 #if defined HAVE_MPI_IO
4350  if(wff%iomode==IO_MODE_MPI)then
4351 
4352    comm=mpi_enreg%comm_cell
4353    me=xmpi_comm_rank(comm)
4354    nproc=xmpi_comm_size(comm)
4355    pos_start=wff%offwff
4356 
4357    ABI_ALLOCATE(offproc,(0:nproc))
4358    offproc = 0
4359    nbrec =2
4360    nrecnpw=3+nbrec
4361 
4362    do isppol=1,nsppol
4363      do ikpt=1,nkpt
4364        nband_k=nband(ikpt+(isppol-1)*nkpt)
4365        npw_k=npwarr(ikpt)
4366        iproc=mpi_enreg%proc_distrb(ikpt,1,isppol)
4367        if (mpi_enreg%paralbd==1) iproc=mpi_enreg%proc_distrb(ikpt,1,isppol)
4368 !      record kg
4369        nreckg=nbrec+ wff%kgwff*3*npw_k
4370 
4371 !      Record npw,nspinor,nband, Record kg
4372        offproc(iproc) = offproc(iproc) + wff%nbOct_int*(nrecnpw+nreckg)
4373 
4374        if (formeig == 0) then
4375 !        Records eigen,occ
4376          nbint=nbrec
4377          nbreal =  2 *nband_k
4378          offproc(iproc) = offproc(iproc) + (wff%nbOct_int*nbint+wff%nbOct_dp*nbreal)
4379 
4380 !        Records cg
4381          offproc(iproc) = offproc(iproc) &
4382 &         + (wff%nbOct_int*nbrec+wff%nbOct_dp*2*npw_k*nspinor)*nband_k
4383 
4384          ippband=iproc
4385          do nbd=1,nband_k
4386            ipp=mpi_enreg%proc_distrb(ikpt,nbd,isppol)
4387            if (ipp /= ippband ) then
4388              ippband=ipp
4389              offproc(ippband)=offproc(ippband)+ wff%nbOct_int*(nrecnpw+nreckg)
4390              offproc(ippband) = offproc(ippband) + (wff%nbOct_int*nbint &
4391 &             +wff%nbOct_dp*nbreal)
4392              offproc(ippband) = offproc(ippband) + (wff%nbOct_int*nbrec &
4393 &             + wff%nbOct_dp*2*npw_k*nspinor)*nband_k
4394            end if
4395          end do
4396        else if (formeig == 1) then
4397 !        record eigen
4398          offproc(iproc) = offproc(iproc) + (wff%nbOct_int*2*nbrec  &
4399 &         + wff%nbOct_dp*2*npw_k*nspinor &
4400 &         + wff%nbOct_dp*2*nband_k)*nband_k
4401          ippband=iproc
4402          do nbd=1,nband_k
4403            ipp=mpi_enreg%proc_distrb(ikpt,nbd,isppol)
4404            if (ipp /= ippband) then
4405              ippband=ipp
4406              offproc(ippband)=offproc(ippband)+ wff%nbOct_int*(nrecnpw+nreckg)
4407              offproc(ippband) = offproc(ippband) + (wff%nbOct_int*2*nbrec  &
4408 &             + wff%nbOct_dp*2*npw_k*nspinor &
4409 &             + wff%nbOct_dp*2*nband_k)*nband_k
4410            end if
4411          end do
4412        end if   ! formeig
4413      end do ! ikpt
4414 
4415    end do ! isppol
4416 
4417 !  pos_start=wff%offwff
4418 !  wff%offwff = pos_start
4419 
4420    if (me/=0)then
4421      do iproc=0,me-1
4422        wff%offwff=wff%offwff+offproc(iproc)
4423      end do
4424    end if
4425    ABI_DEALLOCATE(offproc)
4426 
4427  end if ! iomode
4428 #endif
4429 
4430 end subroutine xdefineOff

m_wffile/xderiveRead_dp [ Functions ]

[ Top ] [ m_wffile ] [ Functions ]

NAME

  xderiveRead_dp

FUNCTION

  Generic routine to read/write wf files with MPI I/O.
  Target: double precision scalar.

INPUTS

 (none)

OUTPUT

  xval= data buffer
  ierr= exit status, a non-zero value meaning there is an error

SIDE EFFECTS

  wff= structured info for reading/writing the wavefunctions

PARENTS

CHILDREN

SOURCE

2785 subroutine xderiveRead_dp(wff,xval,ierr)
2786 
2787 
2788 !This section has been created automatically by the script Abilint (TD).
2789 !Do not modify the following lines by hand.
2790 #undef ABI_FUNC
2791 #define ABI_FUNC 'xderiveRead_dp'
2792 !End of the abilint section
2793 
2794  implicit none
2795 
2796 !Arguments ------------------------------------
2797  type(wffile_type),intent(inout) :: wff
2798  integer,intent(out) :: ierr
2799  real(dp),intent(out) :: xval
2800 
2801 !Local variables-------------------------------
2802 #if defined HAVE_MPI_IO
2803  integer :: statux(MPI_STATUS_SIZE)
2804  real(dp) :: tmparr(1)
2805 #endif
2806  character(len=500) :: msg
2807 
2808 ! *********************************************************************
2809 
2810  xval=zero ; ierr=0
2811  if(.false.)write(std_out,*)wff%me
2812 #if defined HAVE_MPI_IO
2813  call MPI_FILE_READ_AT(wff%fhwff,wff%offwff,tmparr,1,MPI_DOUBLE_PRECISION,statux,ierr)
2814  xval = tmparr(1)
2815  wff%offwff = wff%offwff + wff%nbOct_dp
2816  return
2817 #endif
2818 
2819  write(msg,'(a,i0,a)')' The value of wff%iomode=',wff%iomode,' is not allowed.'
2820  MSG_WARNING(msg)
2821 
2822 end subroutine xderiveRead_dp

m_wffile/xderiveRead_dp2d [ Functions ]

[ Top ] [ m_wffile ] [ Functions ]

NAME

  xderiveRead_dp2d

FUNCTION

  Generic routine to read/write wf files with MPI I/O.
  Target: double precision two-dimensional arrays.

INPUTS

  n1= first dimension of the array
  n2= second dimension of the array
  spaceComm= MPI communicator

OUTPUT

  ierr= exit status, a non-zero value meaning there is an error
  xval= data buffer array

SIDE EFFECTS

  wff= structured info for reading/writing the wavefunctions

PARENTS

CHILDREN

SOURCE

2949 subroutine xderiveRead_dp2d(wff,xval,n1,n2,spaceComm,ierr)
2950 
2951 
2952 !This section has been created automatically by the script Abilint (TD).
2953 !Do not modify the following lines by hand.
2954 #undef ABI_FUNC
2955 #define ABI_FUNC 'xderiveRead_dp2d'
2956 !End of the abilint section
2957 
2958  implicit none
2959 
2960 !Arguments ------------------------------------
2961  type(wffile_type),intent(inout) :: wff
2962  integer,intent(in) :: n1,n2,spaceComm
2963  integer,intent(out) :: ierr
2964  real(dp),intent(out) :: xval(:,:)
2965 
2966 !Local variables-------------------------------
2967 #if defined HAVE_MPI_IO
2968  integer(kind=MPI_OFFSET_KIND) :: delim_record,dispoct,nboct,posit,totoct
2969  integer :: statux(MPI_STATUS_SIZE)
2970 #endif
2971  character(len=500) :: msg
2972 
2973 ! *********************************************************************
2974 
2975  xval(:,:)=zero ; ierr=0 ! Initialization, for the compiler
2976  if(.false.)write(std_out,*)wff%me,n1,n2,spaceComm
2977 
2978 #if defined HAVE_MPI_IO
2979  nboct = wff%nbOct_dp * n1 *n2
2980  posit = wff%offwff
2981  delim_record = posit - wff%off_recs + wff%lght_recs - wff%nbOct_recMarker
2982 
2983  if (delim_record >= nboct) then
2984 !  Compute offset for local part
2985 !  dispoct = sum (nboct, rank=0..me)
2986    if (spaceComm/=MPI_COMM_SELF) then
2987      call MPI_SCAN(nboct,dispoct,1,wff%offset_mpi_type,MPI_SUM,spaceComm,ierr)
2988      posit = posit + dispoct - nboct
2989    end if
2990    call MPI_FILE_READ_AT(wff%fhwff,posit,xval,n1*n2,MPI_DOUBLE_PRECISION,statux,ierr)
2991 
2992 !  get the total number of bits wrote by processors
2993    if (spaceComm/=MPI_COMM_SELF) then
2994      call xmpi_max(dispoct,totoct,spaceComm,ierr)
2995      !call MPI_ALLREDUCE(dispoct,totoct,1,wff%offset_mpi_type,MPI_MAX,spaceComm,ierr)
2996    else
2997      totoct=nboct
2998    end if
2999  else
3000    ierr = 1
3001    nboct =0
3002    totoct = 0
3003  end if
3004 
3005 !new offset
3006  wff%offwff=wff%offwff + totoct
3007  return
3008 #endif
3009 
3010  write(msg,'(a,i0,a)')' The value of wff%iomode=',wff%iomode,' is not allowed.'
3011  MSG_WARNING(msg)
3012 
3013 end subroutine xderiveRead_dp2d

m_wffile/xderiveRead_dp2d_displ [ Functions ]

[ Top ] [ m_wffile ] [ Functions ]

NAME

  xderiveRead_dp2d_displ

FUNCTION

  Generic routine to read/write wf files with MPI I/O.
  Target: double precision two-dimensional arrays.

INPUTS

  n1= first dimension of the array
  n2= second dimension of the array
  spaceComm= MPI communicator
  displace= number of elements for the offset

OUTPUT

  ierr= exit status, a non-zero value meaning there is an error
  xval= data buffer array

SIDE EFFECTS

  wff= structured info for reading/writing the wavefunctions

PARENTS

CHILDREN

SOURCE

3192 subroutine xderiveRead_dp2d_displ(wff,xval,n1,n2,spaceComm,displace,ierr)
3193 
3194 
3195 !This section has been created automatically by the script Abilint (TD).
3196 !Do not modify the following lines by hand.
3197 #undef ABI_FUNC
3198 #define ABI_FUNC 'xderiveRead_dp2d_displ'
3199 !End of the abilint section
3200 
3201   implicit none
3202 
3203 !Arguments ------------------------------------
3204  type(wffile_type),intent(inout) :: wff
3205  integer,intent(in) :: n1,n2,spaceComm
3206  integer,intent(out) :: ierr
3207  real(dp),intent(out):: xval(:,:)
3208  integer,intent(in):: displace(:)
3209 
3210 !Local variables-------------------------------
3211 #if defined HAVE_MPI_IO
3212 !scalars
3213  integer :: filetype,i1,i2,ipos,nb,nbval,totsize,wfftempo
3214 !arrays
3215  integer :: statux(MPI_STATUS_SIZE)
3216  integer,allocatable :: length1(:),type1(:)
3217  integer(kind=MPI_OFFSET_KIND),allocatable :: depl(:),depl1(:),depl_val(:)
3218  real(dp), allocatable :: buf_val(:),val(:)
3219 #endif
3220 
3221 ! *********************************************************************
3222 
3223  xval(:,:)=zero ; ierr=0
3224  if(.false.)write(std_out,*)wff%me,n1,n2,displace,spaceComm
3225 
3226 #if defined HAVE_MPI_IO
3227  nb=n1*n2
3228  call xmpi_sum(nb,totsize,spaceComm,ierr)
3229  ABI_ALLOCATE(depl_val,(0:totsize-1))
3230  ABI_ALLOCATE(depl,(nb))
3231  ABI_ALLOCATE(buf_val,(0:totsize-1))
3232  ABI_ALLOCATE(val,(nb))
3233 
3234 !Map displacements
3235  depl_val(0:totsize-1)=-1
3236  do i2=1,n2
3237    do i1=1,n1
3238      ipos=(displace(i2)-1)*n1 + i1-1
3239      depl_val(ipos)=ipos
3240    end do
3241  end do
3242 !To save time, the location describe by array map must be in increasing order
3243  nbval=0
3244  do i1=0,totsize-1
3245    if (depl_val(i1)/=-1) then
3246      nbval=nbval+1
3247      depl(nbval)=depl_val(i1)
3248    end if
3249  end do
3250 
3251 !Build MPI datatype for view
3252  ABI_ALLOCATE(length1,(nbval+2))
3253  ABI_ALLOCATE(depl1,(nbval+2))
3254  ABI_ALLOCATE(type1,(nbval+2))
3255  length1(1)=1;depl1(1)=0;type1(1)=MPI_LB
3256  do i1=2,nbval+1
3257    length1(i1) = 1
3258    depl1(i1)= depl(i1-1)*wff%nbOct_dp
3259    type1(i1)= MPI_DOUBLE_PRECISION
3260  end do
3261  length1(nbval+2)=1;depl1(nbval+2)=totsize*wff%nbOct_dp;type1(nbval+2)=MPI_UB
3262  call xmpio_type_struct(nbval+2,length1,depl1,type1,filetype,ierr)
3263  call MPI_TYPE_COMMIT(filetype,ierr)
3264  ABI_DEALLOCATE(length1)
3265  ABI_DEALLOCATE(depl1)
3266  ABI_DEALLOCATE(type1)
3267 
3268 !Write data
3269  call MPI_FILE_OPEN(spaceComm,wff%fname,MPI_MODE_RDWR,MPI_INFO_NULL,wfftempo,ierr)
3270  ABI_CHECK_MPI(ierr, sjoin("MPI_FILE_OPEN:", wff%fname))
3271  call MPI_FILE_SET_VIEW(wfftempo,wff%offwff,MPI_BYTE,filetype,"native",MPI_INFO_NULL,ierr)
3272  call MPI_FILE_READ_ALL(wfftempo,val,nbval,MPI_DOUBLE_PRECISION,statux,ierr)
3273  call MPI_FILE_CLOSE(wfftempo,ierr)
3274 
3275 !Retrieve xval
3276  nbval=0
3277  do i1=0,totsize-1
3278    if (depl_val(i1)/=-1) then
3279      nbval=nbval+1
3280      buf_val(i1)=val(nbval)
3281    end if
3282  end do
3283  do i2=1,n2
3284    do i1=1,n1
3285      ipos=(displace(i2)-1)*n1 + i1-1
3286      xval(i1,i2)=buf_val(ipos)
3287    end do
3288  end do
3289 
3290 !Update offset
3291  wff%offwff = wff%offwff + totsize*wff%nbOct_dp
3292 
3293 !Free memory
3294  call MPI_TYPE_FREE(filetype,ierr)
3295  ABI_DEALLOCATE(depl)
3296  ABI_DEALLOCATE(depl_val)
3297  ABI_DEALLOCATE(buf_val)
3298  ABI_DEALLOCATE(val)
3299 #endif
3300 
3301 end subroutine xderiveRead_dp2d_displ

m_wffile/xderiveRead_int [ Functions ]

[ Top ] [ m_wffile ] [ Functions ]

NAME

  xderiveRead_int

FUNCTION

  Generic routine to read/write wf files with MPI I/O.
  Target: integer scalar.

INPUTS

 (none)

OUTPUT

  xval= data buffer
  ierr= exit status, a non-zero value meaning there is an error

SIDE EFFECTS

  wff= structured info for reading/writing the wavefunctions

PARENTS

CHILDREN

SOURCE

2525 subroutine xderiveRead_int(wff,xval,ierr)
2526 
2527 
2528 !This section has been created automatically by the script Abilint (TD).
2529 !Do not modify the following lines by hand.
2530 #undef ABI_FUNC
2531 #define ABI_FUNC 'xderiveRead_int'
2532 !End of the abilint section
2533 
2534  implicit none
2535 
2536 !Arguments ------------------------------------
2537  type(wffile_type),intent(inout) :: wff
2538  integer,intent(out) :: xval
2539  integer,intent(out) :: ierr
2540 
2541 !Local variables-------------------------------
2542 #if defined HAVE_MPI_IO
2543  integer :: statux(MPI_STATUS_SIZE)
2544  integer :: tmparr(1)
2545 #endif
2546  character(len=500) :: msg
2547 
2548 ! *********************************************************************
2549 
2550  xval=0; ierr=0
2551 
2552 #if defined HAVE_MPI_IO
2553  call MPI_FILE_READ_AT(wff%fhwff,wff%offwff,tmparr,1,MPI_INTEGER,statux,ierr)
2554  xval = tmparr(1)
2555  wff%offwff = wff%offwff + wff%nbOct_int
2556  RETURN
2557 #endif
2558 
2559  ABI_UNUSED(wff%me)
2560 
2561  write(msg,'(a,i0,a)')' The value of wff%iomode=',wff%iomode,' is not allowed.'
2562  MSG_WARNING(msg)
2563 
2564 end subroutine xderiveRead_int

m_wffile/xderiveRead_int1d [ Functions ]

[ Top ] [ m_wffile ] [ Functions ]

NAME

  xderiveRead_int1d

FUNCTION

  Generic routine to read/write wf files with MPI I/O.
  Target: one-dimensional integer arrays.

INPUTS

  n1= first dimension of the array
  spaceComm= MPI communicator

OUTPUT

  xval= data buffer array
  ierr= exit status, a non-zero value meaning there is an error

SIDE EFFECTS

  wff= structured info for reading/writing the wavefunctions

PARENTS

CHILDREN

SOURCE

2595 subroutine xderiveRead_int1d(wff,xval,n1,spaceComm,ierr)
2596 
2597 
2598 !This section has been created automatically by the script Abilint (TD).
2599 !Do not modify the following lines by hand.
2600 #undef ABI_FUNC
2601 #define ABI_FUNC 'xderiveRead_int1d'
2602 !End of the abilint section
2603 
2604  implicit none
2605 
2606 !Arguments ------------------------------------
2607  type(wffile_type),intent(inout) :: wff
2608  integer,intent(out) :: xval(:)
2609  integer,intent(in) :: n1,spaceComm
2610  integer,intent(out) :: ierr
2611 
2612 !Local variables-------------------------------
2613 #if defined HAVE_MPI_IO
2614  integer(kind=MPI_OFFSET_KIND) :: delim_record,posit,nboct,dispoct,totoct
2615  integer :: statux(MPI_STATUS_SIZE)
2616 #endif
2617  character(len=500) :: msg
2618 
2619 ! *********************************************************************
2620 
2621  xval(:)=0 ; ierr=0 ! Initialization, for the compiler
2622  if(.false.)write(std_out,*)wff%me,n1,spaceComm
2623 
2624 #if defined HAVE_MPI_IO
2625  nboct = wff%nbOct_int * n1
2626  posit = wff%offwff
2627  delim_record = posit - wff%off_recs + wff%lght_recs - wff%nbOct_recMarker
2628 
2629  if (delim_record >= nboct) then
2630 !  Compute offset for local part
2631 !  dispoct = sum (nboct, rank=0..me)
2632    if (spaceComm/=MPI_COMM_SELF) then
2633      call MPI_SCAN(nboct,dispoct,1,wff%offset_mpi_type,MPI_SUM,spaceComm,ierr)
2634      posit = posit+dispoct-nboct
2635    end if
2636    call MPI_FILE_READ_AT(wff%fhwff,posit,xval,n1,MPI_INTEGER,statux,ierr)
2637 
2638 !  get the total number of bits wrote by processors
2639    if (spaceComm/=MPI_COMM_SELF) then
2640      call xmpi_max(dispoct,totoct,spaceComm,ierr)
2641      !call MPI_ALLREDUCE(dispoct,totoct,1,wff%offset_mpi_type,MPI_MAX,spaceComm,ierr)
2642    else
2643      totoct=nboct
2644    end if
2645  else
2646    ierr = 1
2647    nboct =0
2648    totoct = 0
2649  end if
2650 
2651 !new offset
2652  wff%offwff = wff%offwff + totoct
2653  return
2654 #endif
2655 
2656  write(msg,'(a,i0,a)')' The value of wff%iomode=',wff%iomode,' is not allowed.'
2657  MSG_WARNING(msg)
2658 
2659 end subroutine xderiveRead_int1d

m_wffile/xderiveRead_int2d [ Functions ]

[ Top ] [ m_wffile ] [ Functions ]

NAME

  xderiveRead_int2d

FUNCTION

  Generic routine to read/write wf files with MPI I/O.
  Target: two-dimensional integer arrays.

INPUTS

  n1= first dimension of the array
  n2= second dimension of the array
  spaceComm= MPI communicator

OUTPUT

  xval= data buffer array
  ierr= exit status, a non-zero value meaning there is an error

SIDE EFFECTS

  wff= structured info for reading/writing the wavefunctions

PARENTS

CHILDREN

SOURCE

2691 subroutine xderiveRead_int2d(wff,xval,n1,n2,spaceComm,ierr)
2692 
2693 
2694 !This section has been created automatically by the script Abilint (TD).
2695 !Do not modify the following lines by hand.
2696 #undef ABI_FUNC
2697 #define ABI_FUNC 'xderiveRead_int2d'
2698 !End of the abilint section
2699 
2700  implicit none
2701 
2702 !Arguments ------------------------------------
2703  type(wffile_type),intent(inout) :: wff
2704  integer,intent(out) :: xval(:,:)
2705  integer,intent(in) :: n1,n2,spaceComm
2706  integer,intent(out) :: ierr
2707 
2708 !Local variables-------------------------------
2709 #if defined HAVE_MPI_IO
2710  integer(kind=MPI_OFFSET_KIND) :: delim_record,dispoct,nboct,posit,totoct
2711  integer :: statux(MPI_STATUS_SIZE)
2712 #endif
2713  character(len=500) :: msg
2714 
2715 ! *********************************************************************
2716 
2717  xval(:,:)=0 ; ierr=0 ! Initialization, for the compiler
2718  if(.false.)write(std_out,*)wff%me,n1,n2,spaceComm
2719 
2720 #if defined HAVE_MPI_IO
2721  nboct = wff%nbOct_int * n1 * n2
2722  posit = wff%offwff
2723  delim_record = posit - wff%off_recs + wff%lght_recs - wff%nbOct_recMarker
2724 
2725  if (delim_record >= nboct) then
2726 !  Compute offset for local part
2727 !  dispoct = sum (nboct, rank=0..me)
2728    if (spaceComm/=MPI_COMM_SELF) then
2729      call MPI_SCAN(nboct,dispoct,1,wff%offset_mpi_type,MPI_SUM,spaceComm,ierr)
2730      posit = posit + dispoct - nboct
2731    end if
2732    call MPI_FILE_READ_AT(wff%fhwff,posit,xval,n1*n2,MPI_INTEGER,statux,ierr)
2733 
2734 !  get the total number of bits wrote by processors
2735    if (spaceComm/=MPI_COMM_SELF) then
2736      call xmpi_max(dispoct,totoct,spaceComm,ierr)
2737      !call MPI_ALLREDUCE(dispoct,totoct,1,wff%offset_mpi_type,MPI_MAX,spaceComm,ierr)
2738    else
2739      totoct=nboct
2740    end if
2741  else
2742    ierr = 1
2743    nboct =0
2744    totoct = 0
2745  end if
2746 
2747 !new offset
2748  wff%offwff=wff%offwff + totoct
2749  return
2750 #endif
2751 
2752  write(msg,'(a,i0,a)')' The value of wff%iomode=',wff%iomode,' is not allowed.'
2753  MSG_WARNING(msg)
2754 
2755 end subroutine xderiveRead_int2d

m_wffile/xderiveRead_int2d_displ [ Functions ]

[ Top ] [ m_wffile ] [ Functions ]

NAME

  xderiveRead_int2d_displ

FUNCTION

  Generic routine to read/write wf files with MPI I/O.
  Target: two-dimensional integer arrays.

INPUTS

  n1= first dimension of the array
  n2= second dimension of the array
  spaceComm= MPI communicator
  displace= number of elements for the offset

OUTPUT

  ierr= exit status, a non-zero value meaning there is an error
  xval= data buffer array

SIDE EFFECTS

  wff= structured info for reading/writing the wavefunctions

PARENTS

CHILDREN

SOURCE

3046 subroutine xderiveRead_int2d_displ(wff,xval,n1,n2,spaceComm,displace,ierr)
3047 
3048 
3049 !This section has been created automatically by the script Abilint (TD).
3050 !Do not modify the following lines by hand.
3051 #undef ABI_FUNC
3052 #define ABI_FUNC 'xderiveRead_int2d_displ'
3053 !End of the abilint section
3054 
3055   implicit none
3056 
3057 !Arguments ------------------------------------
3058  type(wffile_type),intent(inout) :: wff
3059  integer,intent(in) :: n1,n2,spaceComm
3060  integer,intent(out) :: ierr
3061  integer,intent(out):: xval(:,:)
3062  integer,intent(in):: displace(:)
3063 
3064 !Local variables-------------------------------
3065 #if defined HAVE_MPI_IO
3066 !scalars
3067  integer :: filetype,i1,i2,ipos,nb,nbval,totsize,wfftempo
3068 !arrays
3069  integer :: statux(MPI_STATUS_SIZE)
3070  integer,allocatable :: buf_val(:),length1(:),type1(:),val(:)
3071  integer(kind=MPI_OFFSET_KIND),allocatable :: depl(:),depl1(:),depl_val(:)
3072 #endif
3073  character(len=500) :: msg
3074 
3075 ! *********************************************************************
3076 
3077  xval(:,:)=0 ; ierr=0
3078  if(.false.)write(std_out,*)wff%me,n1,n2,spaceComm,displace
3079 
3080 #if defined HAVE_MPI_IO
3081  nb=n1*n2
3082  call xmpi_sum(nb,totsize,spaceComm,ierr)
3083  ABI_ALLOCATE(depl_val,(0:totsize-1))
3084  ABI_ALLOCATE(depl,(nb))
3085  ABI_ALLOCATE(buf_val,(0:totsize-1))
3086  ABI_ALLOCATE(val,(nb))
3087 
3088 !Map displacements
3089  depl_val(0:totsize-1)=-1
3090  do i2=1,n2
3091    do i1=1,n1
3092      ipos=(displace(i2)-1)*n1 + i1-1
3093      depl_val(ipos)=ipos
3094    end do
3095  end do
3096 !To save time, the location describe by array map must be in increasing order
3097  nbval=0
3098  do i1=0,totsize-1
3099    if (depl_val(i1)/=-1) then
3100      nbval=nbval+1
3101      depl(nbval)=depl_val(i1)
3102    end if
3103  end do
3104 
3105 !Build MPI datatype for view
3106  ABI_ALLOCATE(length1,(nbval+2))
3107  ABI_ALLOCATE(depl1,(nbval+2))
3108  ABI_ALLOCATE(type1,(nbval+2))
3109  length1(1)=1;depl1(1)=0;type1(1)=MPI_LB
3110  do i1=2,nbval+1
3111    length1(i1) = 1
3112    depl1(i1)= depl(i1-1)*wff%nbOct_int
3113    type1(i1)= MPI_INTEGER
3114  end do
3115  length1(nbval+2)=1;depl1(nbval+2)=totsize*wff%nbOct_int;type1(nbval+2)=MPI_UB
3116  call xmpio_type_struct(nbval+2,length1,depl1,type1,filetype,ierr)
3117  call MPI_TYPE_COMMIT(filetype,ierr)
3118  ABI_DEALLOCATE(length1)
3119  ABI_DEALLOCATE(depl1)
3120  ABI_DEALLOCATE(type1)
3121 
3122 !Write data
3123  call MPI_FILE_OPEN(spaceComm,wff%fname,MPI_MODE_RDWR,MPI_INFO_NULL,wfftempo,ierr)
3124  ABI_CHECK_MPI(ierr, sjoin("MPI_FILE_OPEN:", wff%fname))
3125  call MPI_FILE_SET_VIEW(wfftempo,wff%offwff,MPI_BYTE,filetype,"native",MPI_INFO_NULL,ierr)
3126  call MPI_FILE_READ_ALL(wfftempo,val,nbval,MPI_INTEGER,statux,ierr)
3127  call MPI_FILE_CLOSE(wfftempo,ierr)
3128 
3129 !Retrieve xval
3130  nbval=0
3131  do i1=0,totsize-1
3132    if (depl_val(i1)/=-1) then
3133      nbval=nbval+1
3134      buf_val(i1)=val(nbval)
3135    end if
3136  end do
3137  do i2=1,n2
3138    do i1=1,n1
3139      ipos=(displace(i2)-1)*n1 + i1-1
3140      xval(i1,i2)=buf_val(ipos)
3141    end do
3142  end do
3143 
3144 !Update offset
3145  wff%offwff = wff%offwff + totsize*wff%nbOct_int
3146 
3147 !Free memory
3148  call MPI_TYPE_FREE(filetype,ierr)
3149  ABI_DEALLOCATE(depl)
3150  ABI_DEALLOCATE(depl_val)
3151  ABI_DEALLOCATE(buf_val)
3152  ABI_DEALLOCATE(val)
3153  return
3154 #endif
3155 
3156  write(msg,'(a,i0,a)')' The value of wff%iomode=',wff%iomode,' is not allowed.'
3157  MSG_WARNING(msg)
3158 
3159 
3160 end subroutine xderiveRead_int2d_displ

m_wffile/xderiveReadVal_char [ Functions ]

[ Top ] [ m_wffile ] [ Functions ]

NAME

  xderiveReadVal_char

FUNCTION

  Generic routine to read/write wf files with MPI I/O.
  Target: character string.

INPUTS

  n= number of elements in the array

OUTPUT

  xval= data buffer array
  ierr= exit status, a non-zero value meaning there is an error

SIDE EFFECTS

  wff= structured info for reading/writing the wavefunctions

PARENTS

CHILDREN

SOURCE

3330 subroutine xderiveReadVal_char(wff,xval,n,ierr)
3331 
3332 
3333 !This section has been created automatically by the script Abilint (TD).
3334 !Do not modify the following lines by hand.
3335 #undef ABI_FUNC
3336 #define ABI_FUNC 'xderiveReadVal_char'
3337 !End of the abilint section
3338 
3339  implicit none
3340 
3341 !Arguments ------------------------------------
3342  type(wffile_type),intent(inout) :: wff
3343  integer,intent(in) :: n
3344  integer,intent(out) :: ierr
3345  character(len=*),intent(out) :: xval
3346 
3347 !Local variables-------------------------------
3348 #if defined HAVE_MPI_IO
3349  integer :: statux(MPI_STATUS_SIZE)
3350  character(len=len(xval)) :: tmparr(1)
3351 #endif
3352 
3353 ! *********************************************************************
3354 
3355  xval=' ' ; ierr=0
3356  if(.false.)write(std_out,*)wff%me,n
3357 
3358 #if defined HAVE_MPI_IO
3359  call MPI_FILE_READ_AT(wff%fhwff,wff%offwff,tmparr,n,MPI_CHARACTER,statux,ierr)
3360  xval = tmparr(1)
3361  wff%offwff = wff%offwff + wff%nbOct_ch * n
3362 #endif
3363 
3364 end subroutine xderiveReadVal_char

m_wffile/xderiveRRecEnd [ Functions ]

[ Top ] [ m_wffile ] [ Functions ]

NAME

  xderiveRRecEnd

FUNCTION

  Initializes the end-of-record offset for MPI/IO.

INPUTS

  me_proc= (optional argument) index of current proc

OUTPUT

  ierr= exit status, a non-zero value meaning there is an error

SIDE EFFECTS

  wff= structured info for reading/writing the wavefunctions

PARENTS

      m_ioarr,m_wffile,outxfhist,rwwf

CHILDREN

NOTES

  We assume that:
    wff%off_recs contains the position of the beginning of the record

SOURCE

832 subroutine xderiveRRecEnd(wff,ierr)
833 
834 !Arguments ------------------------------------
835 
836 !This section has been created automatically by the script Abilint (TD).
837 !Do not modify the following lines by hand.
838 #undef ABI_FUNC
839 #define ABI_FUNC 'xderiveRRecEnd'
840 !End of the abilint section
841 
842  integer,intent(out) ::  ierr
843  type(wffile_type),intent(inout) :: wff
844 
845 ! *************************************************************************
846 
847  ierr=0
848 #if defined HAVE_MPI_IO
849 !Define offset end of record
850  wff%offwff = wff%off_recs + wff%lght_recs + 2*wff%nbOct_recMarker
851 #endif
852 
853  RETURN
854  ABI_UNUSED(wff%me)
855 
856 end subroutine xderiveRRecEnd

m_wffile/xderiveRRecInit [ Functions ]

[ Top ] [ m_wffile ] [ Functions ]

NAME

  xderiveRRecInit

FUNCTION

  Initializes the record length for MPI/IO.

INPUTS

  me_proc= (optional argument) index of current proc

OUTPUT

  ierr= exit status, a non-zero value meaning there is an error

SIDE EFFECTS

  wff= structured info for reading/writing the wavefunctions

PARENTS

      m_ioarr,m_wffile,outxfhist,rwwf

CHILDREN

NOTES

  We assume that:
    wff%offwff contains the position of the beginning of the record

SOURCE

888 subroutine xderiveRRecInit(wff,ierr)
889 
890 
891 !This section has been created automatically by the script Abilint (TD).
892 !Do not modify the following lines by hand.
893 #undef ABI_FUNC
894 #define ABI_FUNC 'xderiveRRecInit'
895 !End of the abilint section
896 
897  implicit none
898 
899 !Arguments ------------------------------------
900  type(wffile_type),intent(inout) :: wff
901  integer,intent(out) :: ierr
902 
903 !Local variables-------------------------------
904 #if defined HAVE_MPI_IO
905  integer(kind=MPI_OFFSET_KIND) :: delim_record,posit
906 #endif
907 
908 ! *************************************************************************
909 
910  ierr=0
911 
912 #if defined HAVE_MPI_IO
913  wff%off_recs = wff%offwff
914 
915 !Read the length of the record
916  posit=wff%off_recs
917  call rwRecordMarker(1,posit,delim_record,wff,ierr)
918 
919  wff%lght_recs = delim_record
920  wff%offwff =  wff%offwff + wff%nbOct_recMarker
921 #endif
922 
923  RETURN
924  ABI_UNUSED(wff%me)
925 
926 end subroutine xderiveRRecInit

m_wffile/xderiveWRecEnd [ Functions ]

[ Top ] [ m_wffile ] [ Functions ]

NAME

  xderiveWRecEnd

FUNCTION

  Writes the first and last wavefunction block marker using MPI/IO

INPUTS

  me_proc= (optional argument) index of current proc

OUTPUT

  ierr= exit status, a non-zero value meaning there is an error

SIDE EFFECTS

  wff= structured info for reading/writing the wavefunctions

PARENTS

      m_ioarr,m_wffile,outxfhist,posdoppler,rwwf

CHILDREN

NOTES

  We assume that:
    wff%offwff contains the position of the end of the record
    wff%off_recs contains the position of the beginning of the record

SOURCE

673 subroutine xderiveWRecEnd(wff,ierr,me_proc)
674 
675 
676 !This section has been created automatically by the script Abilint (TD).
677 !Do not modify the following lines by hand.
678 #undef ABI_FUNC
679 #define ABI_FUNC 'xderiveWRecEnd'
680 !End of the abilint section
681 
682  implicit none
683 
684 !Arguments ------------------------------------
685  type(wffile_type),intent(inout) :: wff
686  integer,intent(in),optional :: me_proc
687  integer,intent(out) :: ierr
688 
689 !Local variables-------------------------------
690 #if defined HAVE_MPI_IO
691 !scalars
692  integer :: me
693  integer(kind=MPI_OFFSET_KIND) :: delim_record,posit
694 !arrays
695 #endif
696 
697 ! *************************************************************************
698 
699  ierr=0
700 
701 #if defined HAVE_MPI_IO
702  me=-1;if (present(me_proc)) me=me_proc
703  if (me==-1.or.me==0) then
704 
705    delim_record=wff%offwff-wff%off_recs-wff%nbOct_recMarker
706 
707 !  Write the first word of the record
708    posit=wff%off_recs
709    call rwRecordMarker(2,posit,delim_record,wff,ierr)
710 
711 !  Write the last word of the record
712    posit=wff%offwff
713    call rwRecordMarker(2,posit,delim_record,wff,ierr)
714 
715  end if
716 
717  wff%offwff = wff%offwff + wff%nbOct_recMarker
718 #endif
719 
720  RETURN
721  ABI_UNUSED((/wff%me,me_proc/))
722 
723 end subroutine xderiveWRecEnd

m_wffile/xderiveWRecInit [ Functions ]

[ Top ] [ m_wffile ] [ Functions ]

NAME

  xderiveWRecInit

FUNCTION

  Writes the first wavefunction block marker using MPI/IO.

INPUTS

  me_proc= (optional argument) index of current proc

OUTPUT

  ierr= exit status, a non-zero value meaning there is an error

SIDE EFFECTS

  wff= structured info for reading/writing the wavefunctions

PARENTS

      m_ioarr,m_wffile,outxfhist,posdoppler,rwwf

CHILDREN

NOTES

  We assume that:
    wff%offwff contains the position of the beginning of the record

SOURCE

755 subroutine xderiveWRecInit(wff,ierr,me_proc)
756 
757 
758 !This section has been created automatically by the script Abilint (TD).
759 !Do not modify the following lines by hand.
760 #undef ABI_FUNC
761 #define ABI_FUNC 'xderiveWRecInit'
762 !End of the abilint section
763 
764  implicit none
765 
766 !Arguments ------------------------------------
767  type(wffile_type),intent(inout) :: wff
768  integer,intent(in),optional :: me_proc
769  integer,intent(out) :: ierr
770 
771 !Local variables-------------------------------
772 #if defined HAVE_MPI_IO
773 !scalars
774  integer :: me
775  integer(kind=MPI_OFFSET_KIND) :: delim_record,posit
776 !arrays
777 #endif
778 
779 ! *************************************************************************
780 
781  ierr=0
782 
783 #if defined HAVE_MPI_IO
784  me=-1;if (present(me_proc)) me=me_proc
785  if (me==-1.or.me==0) then
786 
787 !  Write the first word of the record
788    posit=wff%offwff;delim_record=0
789    call rwRecordMarker(2,posit,delim_record,wff,ierr)
790 
791  end if
792 
793  wff%off_recs = wff%offwff
794  wff%offwff = wff%offwff + wff%nbOct_recMarker
795 #endif
796 
797  RETURN
798  ABI_UNUSED((/wff%me,me_proc/))
799 
800 end subroutine xderiveWRecInit

m_wffile/xderiveWrite_char [ Functions ]

[ Top ] [ m_wffile ] [ Functions ]

NAME

  xderiveWrite_char

FUNCTION

  Generic routine to read/write wf files with MPI I/O.
  Target: character string.

INPUTS

  xval= data buffer array
  n= number of elements in the string

OUTPUT

  ierr= exit status, a non-zero value meaning there is an error

SIDE EFFECTS

  wff= structured info for reading/writing the wavefunctions

PARENTS

CHILDREN

SOURCE

4246 subroutine xderiveWrite_char(wff,xval,n,ierr)
4247 
4248 
4249 !This section has been created automatically by the script Abilint (TD).
4250 !Do not modify the following lines by hand.
4251 #undef ABI_FUNC
4252 #define ABI_FUNC 'xderiveWrite_char'
4253 !End of the abilint section
4254 
4255  implicit none
4256 
4257 !Arguments ------------------------------------
4258  type(wffile_type),intent(inout) :: wff
4259  integer,intent(in) :: n
4260  integer,intent(out) :: ierr
4261  character(len=*),intent(in) :: xval
4262 
4263 !Local variables-------------------------------
4264 #if defined HAVE_MPI_IO
4265  integer :: statux(MPI_STATUS_SIZE)
4266 #endif
4267 ! *********************************************************************
4268 
4269  ierr=0
4270  if(.false.)write(std_out,*)wff%me,xval,n
4271 
4272 #if defined HAVE_MPI_IO
4273  call MPI_FILE_WRITE_AT(wff%fhwff,wff%offwff,xval,n,MPI_CHARACTER,statux,ierr)
4274  wff%offwff = wff%offwff + wff%nbOct_ch * n
4275 #endif
4276 
4277 end subroutine xderiveWrite_char

m_wffile/xderiveWrite_dp [ Functions ]

[ Top ] [ m_wffile ] [ Functions ]

NAME

  xderiveWrite_dp

FUNCTION

  Generic routine to read/write wf files with MPI I/O.
  Target: double precision scalar.

INPUTS

  xval= data buffer

OUTPUT

  ierr= exit status, a non-zero value meaning there is an error

SIDE EFFECTS

  wff= structured info for reading/writing the wavefunctions

PARENTS

CHILDREN

SOURCE

3712 subroutine xderiveWrite_dp(wff,xval,ierr)
3713 
3714 
3715 !This section has been created automatically by the script Abilint (TD).
3716 !Do not modify the following lines by hand.
3717 #undef ABI_FUNC
3718 #define ABI_FUNC 'xderiveWrite_dp'
3719 !End of the abilint section
3720 
3721  implicit none
3722 
3723 !Arguments ------------------------------------
3724  integer,intent(out) :: ierr
3725  real(dp),intent(in):: xval
3726  type(wffile_type),intent(inout) :: wff
3727 
3728 !Local variables-------------------------------
3729 #if defined HAVE_MPI_IO
3730  integer :: statux(MPI_STATUS_SIZE)
3731  real(dp) :: tmparr(1)
3732 #endif
3733 ! *********************************************************************
3734 
3735  ierr=0
3736  if(.false.)write(std_out,*)wff%me,xval
3737 #if defined HAVE_MPI_IO
3738  tmparr(1) = xval
3739  call MPI_FILE_WRITE_AT(wff%fhwff,wff%offwff,tmparr,1,MPI_DOUBLE_PRECISION,statux,ierr)
3740  wff%offwff = wff%offwff+wff%nbOct_dp
3741 #endif
3742 
3743 end subroutine xderiveWrite_dp

m_wffile/xderiveWrite_dp1d [ Functions ]

[ Top ] [ m_wffile ] [ Functions ]

NAME

  xderiveWrite_dp1d

FUNCTION

  Generic routine to read/write wf files with MPI I/O.
  Target: one-dimensional double precision arrays.

INPUTS

  n1= first dimension of the array
  spaceComm= MPI communicator
  xval= data buffer array

OUTPUT

  ierr= exit status, a non-zero value meaning there is an error

SIDE EFFECTS

  wff= structured info for reading/writing the wavefunctions

PARENTS

CHILDREN

SOURCE

3774 subroutine xderiveWrite_dp1d(wff,xval,n1,spaceComm,ierr)
3775 
3776 
3777 !This section has been created automatically by the script Abilint (TD).
3778 !Do not modify the following lines by hand.
3779 #undef ABI_FUNC
3780 #define ABI_FUNC 'xderiveWrite_dp1d'
3781 !End of the abilint section
3782 
3783  implicit none
3784 
3785 !Arguments ------------------------------------
3786  integer,intent(in) :: n1,spaceComm
3787  integer,intent(out) :: ierr
3788  real(dp),intent(in):: xval(:)
3789  type(wffile_type),intent(inout) :: wff
3790 
3791 !Local variables-------------------------------
3792 #if defined HAVE_MPI_IO
3793  integer(kind=MPI_OFFSET_KIND) :: nboct,dispoct,totoct,posit
3794  integer  :: statux(MPI_STATUS_SIZE)
3795 #endif
3796 
3797 ! *********************************************************************
3798 
3799  ierr=0
3800  if(.false.)write(std_out,*)wff%me,n1,spaceComm,xval
3801 #if defined HAVE_MPI_IO
3802  nboct = n1*wff%nbOct_dp
3803  posit = wff%offwff
3804 !dispoct = sum (nboct, rank = 0..me)
3805  if (spaceComm/=MPI_COMM_SELF) then
3806    call MPI_SCAN(nboct,dispoct,1,wff%offset_mpi_type,MPI_SUM,spaceComm,ierr)
3807    posit = posit + dispoct - nboct
3808  end if
3809  call MPI_FILE_WRITE_AT(wff%fhwff,posit,xval,n1,MPI_DOUBLE_PRECISION,statux,ierr)
3810 !Gather the biggest offset
3811  if (spaceComm/=MPI_COMM_SELF) then
3812    call xmpi_max(dispoct,totoct,spaceComm,ierr)
3813    !call MPI_ALLREDUCE(dispoct,totoct,1,wff%offset_mpi_type,MPI_MAX,spaceComm,ierr)
3814  else
3815    totoct=nboct
3816  end if
3817  wff%offwff = wff%offwff + totoct
3818 #endif
3819 
3820 end subroutine xderiveWrite_dp1d

m_wffile/xderiveWrite_dp2d [ Functions ]

[ Top ] [ m_wffile ] [ Functions ]

NAME

  xderiveWrite_dp2d

FUNCTION

  Generic routine to read/write wf files with MPI I/O.
  Target: double precision two-dimensional arrays.

INPUTS

  n1= first dimension of the array
  n2= second dimension of the array
  spaceComm= MPI communicator
  xval= data buffer array

OUTPUT

  ierr= exit status, a non-zero value meaning there is an error

SIDE EFFECTS

  wff= structured info for reading/writing the wavefunctions

PARENTS

CHILDREN

SOURCE

3851 subroutine xderiveWrite_dp2d(wff,xval,n1,n2,spaceComm,ierr)
3852 
3853 
3854 !This section has been created automatically by the script Abilint (TD).
3855 !Do not modify the following lines by hand.
3856 #undef ABI_FUNC
3857 #define ABI_FUNC 'xderiveWrite_dp2d'
3858 !End of the abilint section
3859 
3860  implicit none
3861 
3862 !Arguments ------------------------------------
3863  integer,intent(in) :: n1,n2,spaceComm
3864  integer,intent(out) :: ierr
3865  real(dp),intent(in):: xval(:,:)
3866  type(wffile_type),intent(inout) :: wff
3867 
3868 !Local variables-------------------------------
3869 #if defined HAVE_MPI_IO
3870  integer(kind=MPI_OFFSET_KIND) :: nboct,dispoct,totoct,posit
3871  integer :: statux(MPI_STATUS_SIZE)
3872 #endif
3873 
3874 ! *********************************************************************
3875 
3876  ierr=0
3877  if(.false.)write(std_out,*)wff%me,xval,n1,n2,spaceComm
3878 
3879 #if defined HAVE_MPI_IO
3880  nboct = n1*n2*wff%nbOct_dp
3881  posit = wff%offwff
3882 !dispoct = sum(nboct, rank=0..me)
3883  if (spaceComm/=MPI_COMM_SELF) then
3884    call MPI_SCAN(nboct,dispoct,1,wff%offset_mpi_type,MPI_SUM,spaceComm,ierr)
3885    posit = posit+dispoct-nboct
3886  end if
3887  call MPI_FILE_WRITE_AT(wff%fhwff,posit,xval,n1*n2,MPI_DOUBLE_PRECISION,statux,ierr)
3888  posit = posit+nboct
3889 !gather the biggest offset
3890  if (spaceComm/=MPI_COMM_SELF) then
3891    call xmpi_max(dispoct,totoct,spaceComm,ierr)
3892    !call MPI_ALLREDUCE(dispoct,totoct,1,wff%offset_mpi_type,MPI_MAX,spaceComm,ierr)
3893  else
3894    totoct=nboct
3895  end if
3896  wff%offwff = wff%offwff+totoct
3897 #endif
3898 
3899 end subroutine xderiveWrite_dp2d

m_wffile/xderiveWrite_dp2d_displ [ Functions ]

[ Top ] [ m_wffile ] [ Functions ]

NAME

  xderiveWrite_dp2d_displ

FUNCTION

  Generic routine to read/write wf files with MPI I/O.
  Target: two-dimensional double precision arrays.

INPUTS

  n1= first dimension of the array
  n2= second dimension of the array
  spaceComm= MPI communicator
  xval= data buffer array
  displace= number of elements for the offset

OUTPUT

  ierr= exit status, a non-zero value meaning there is an error

SIDE EFFECTS

  wff= structured info for reading/writing the wavefunctions

PARENTS

CHILDREN

SOURCE

4119 subroutine xderiveWrite_dp2d_displ(wff,xval,n1,n2,spaceComm,displace,ierr)
4120 
4121 
4122 !This section has been created automatically by the script Abilint (TD).
4123 !Do not modify the following lines by hand.
4124 #undef ABI_FUNC
4125 #define ABI_FUNC 'xderiveWrite_dp2d_displ'
4126 !End of the abilint section
4127 
4128  implicit none
4129 
4130 !Arguments ------------------------------------
4131  integer,intent(in) :: n1,n2,spaceComm
4132  integer,intent(out) :: ierr
4133  integer,intent(in):: displace(:)
4134  real(dp),intent(in) :: xval(:,:)
4135  type(wffile_type),intent(inout) :: wff
4136 
4137 !Local variables-------------------------------
4138 #if defined HAVE_MPI_IO
4139 !scalars
4140  integer :: filetype,i1,i2,ipos,nb,nbval,totsize,wfftempo
4141 !arrays
4142  integer :: statux(MPI_STATUS_SIZE)
4143  integer, allocatable :: length1(:),type1(:)
4144  integer(kind=MPI_OFFSET_KIND),allocatable :: depl(:),depl1(:),depl_val(:)
4145  real(dp),allocatable :: buf_val(:),val(:)
4146 #endif
4147 
4148 ! *********************************************************************
4149 
4150  ierr=0
4151  if(.false.)write(std_out,*)wff%me,xval,n1,n2,spaceComm,displace
4152 
4153 #if defined HAVE_MPI_IO
4154  nb = n1*n2
4155  call xmpi_sum(nb,totsize,spaceComm,ierr)
4156  ABI_ALLOCATE(depl_val,(0:totsize-1))
4157  ABI_ALLOCATE(depl,(nb))
4158  ABI_ALLOCATE(buf_val,(0:totsize-1))
4159  ABI_ALLOCATE(val,(nb))
4160 
4161 !Map displacements
4162 !Put xval in a buffer at its position
4163  depl_val(0:totsize-1)=-1
4164  do i2=1,n2
4165    do i1=1,n1
4166 !    ipos location of xval(i1,i2) in the array associated with record to be written
4167      ipos=(displace(i2)-1)*n1 + i1-1
4168      buf_val(ipos) = xval(i1,i2)
4169      depl_val(ipos) = ipos
4170    end do
4171  end do
4172 !To save time, the location describe by array map must be in increasing order
4173  nbval=0
4174  do i1=0,totsize-1
4175    if (depl_val(i1)/=-1) then
4176      nbval=nbval+1
4177      val(nbval)=buf_val(i1)
4178      depl(nbval)=depl_val(i1)
4179    end if
4180  end do
4181 
4182 !Build MPI datatype for view
4183  ABI_ALLOCATE(length1,(nbval+2))
4184  ABI_ALLOCATE(depl1,(nbval+2))
4185  ABI_ALLOCATE(type1,(nbval+2))
4186  length1(1)=1;depl1(1)=0;type1(1)=MPI_LB
4187  do i1=2,nbval+1
4188    length1(i1) = 1
4189    depl1(i1)= depl(i1-1)*wff%nbOct_dp
4190    type1(i1)= MPI_DOUBLE_PRECISION
4191  end do
4192  length1(nbval+2)=1;depl1(nbval+2)=totsize*wff%nbOct_dp;type1(nbval+2)=MPI_UB
4193  call xmpio_type_struct(nbval+2,length1,depl1,type1,filetype,ierr)
4194  call MPI_TYPE_COMMIT(filetype,ierr)
4195  ABI_DEALLOCATE(length1)
4196  ABI_DEALLOCATE(depl1)
4197  ABI_DEALLOCATE(type1)
4198 
4199 !Write data
4200  call MPI_FILE_OPEN(spaceComm,wff%fname,MPI_MODE_RDWR,MPI_INFO_NULL,wfftempo,ierr)
4201  ABI_CHECK_MPI(ierr, sjoin("MPI_FILE_OPEN:", wff%fname))
4202  call MPI_FILE_SET_VIEW(wfftempo,wff%offwff,MPI_BYTE,filetype,"native",MPI_INFO_NULL,ierr)
4203  call MPI_FILE_WRITE_ALL(wfftempo,val,nbval,MPI_DOUBLE_PRECISION,statux,ierr)
4204  call MPI_FILE_CLOSE(wfftempo,ierr)
4205 
4206  wff%offwff = wff%offwff + totsize*wff%nbOct_dp
4207 
4208 !Free memory
4209  call MPI_TYPE_FREE(filetype,ierr)
4210  ABI_DEALLOCATE(depl)
4211  ABI_DEALLOCATE(depl_val)
4212  ABI_DEALLOCATE(buf_val)
4213  ABI_DEALLOCATE(val)
4214 #endif
4215 
4216 end subroutine xderiveWrite_dp2d_displ

m_wffile/xderiveWrite_dp2d_seq [ Functions ]

[ Top ] [ m_wffile ] [ Functions ]

NAME

  xderiveWrite_dp2d_seq

FUNCTION

  Generic routine to read/write wf files with MPI I/O.
  Target: double precision two-dimensional arrays.

INPUTS

  xval= data buffer array

OUTPUT

  ierr= exit status, a non-zero value meaning there is an error

SIDE EFFECTS

  wff= structured info for reading/writing the wavefunctions

PARENTS

CHILDREN

SOURCE

3927 subroutine xderiveWrite_dp2d_seq(wff,xval,ierr)
3928 
3929 
3930 !This section has been created automatically by the script Abilint (TD).
3931 !Do not modify the following lines by hand.
3932 #undef ABI_FUNC
3933 #define ABI_FUNC 'xderiveWrite_dp2d_seq'
3934 !End of the abilint section
3935 
3936  implicit none
3937 
3938 !Arguments ------------------------------------
3939  integer,intent(out) :: ierr
3940  real(dp),intent(in):: xval(:,:)
3941  type(wffile_type),intent(inout) :: wff
3942 
3943 !Local variables-------------------------------
3944 #if defined HAVE_MPI_IO
3945  integer :: n1,n2
3946  integer :: statux(MPI_STATUS_SIZE)
3947 #endif
3948 ! *********************************************************************
3949 
3950  ierr=0
3951  if(.false.)write(std_out,*)wff%me,xval
3952 #if defined HAVE_MPI_IO
3953  n1=size(xval,1);n2=size(xval,2)
3954  call MPI_FILE_WRITE_AT(wff%fhwff,wff%offwff,xval,n1*n2,MPI_DOUBLE_PRECISION,statux,ierr)
3955  wff%offwff = wff%offwff+wff%nbOct_dp*n1*n2
3956 #endif
3957 
3958 end subroutine xderiveWrite_dp2d_seq

m_wffile/xderiveWrite_int [ Functions ]

[ Top ] [ m_wffile ] [ Functions ]

NAME

  xderiveWrite_int

FUNCTION

  Generic routine to read/write wf files with MPI I/O.
  Target: integer scalar.

INPUTS

  xval= data buffer

OUTPUT

  ierr= exit status, a non-zero value meaning there is an error

SIDE EFFECTS

  wff= structured info for reading/writing the wavefunctions

PARENTS

CHILDREN

SOURCE

3494 subroutine xderiveWrite_int(wff,xval,ierr)
3495 
3496 
3497 !This section has been created automatically by the script Abilint (TD).
3498 !Do not modify the following lines by hand.
3499 #undef ABI_FUNC
3500 #define ABI_FUNC 'xderiveWrite_int'
3501 !End of the abilint section
3502 
3503  implicit none
3504 
3505 !Arguments ------------------------------------
3506  integer,intent(out) :: ierr
3507  integer,intent(in):: xval
3508  type(wffile_type),intent(inout) :: wff
3509 
3510 !Local variables-------------------------------
3511 #if defined HAVE_MPI_IO
3512  integer :: tmparr(1)
3513  integer :: statux(MPI_STATUS_SIZE)
3514 #endif
3515 ! *********************************************************************
3516 
3517  ierr=0
3518  if(.false.)write(std_out,*)wff%me,xval
3519 #if defined HAVE_MPI_IO
3520  tmparr(1) = xval
3521  call MPI_FILE_WRITE_AT(wff%fhwff,wff%offwff,tmparr,1,MPI_INTEGER,statux,ierr)
3522  wff%offwff = wff%offwff+wff%nbOct_int
3523 #endif
3524 
3525 end subroutine xderiveWrite_int

m_wffile/xderiveWrite_int1d [ Functions ]

[ Top ] [ m_wffile ] [ Functions ]

NAME

  xderiveWrite_int1d

FUNCTION

  Generic routine to read/write wf files with MPI I/O.
  Target: one-dimensional integer arrays.

INPUTS

  n1= first dimension of the array
  spaceComm= MPI communicator
  xval= data buffer array

OUTPUT

  ierr= exit status, a non-zero value meaning there is an error

SIDE EFFECTS

  wff= structured info for reading/writing the wavefunctions

PARENTS

CHILDREN

SOURCE

3556 subroutine xderiveWrite_int1d(wff,xval,n1,spaceComm,ierr)
3557 
3558 
3559 !This section has been created automatically by the script Abilint (TD).
3560 !Do not modify the following lines by hand.
3561 #undef ABI_FUNC
3562 #define ABI_FUNC 'xderiveWrite_int1d'
3563 !End of the abilint section
3564 
3565  implicit none
3566 
3567 !Arguments ------------------------------------
3568  integer,intent(in) :: n1,spaceComm
3569  integer,intent(out) :: ierr
3570  integer,intent(in):: xval(:)
3571  type(wffile_type),intent(inout) :: wff
3572 
3573 !Local variables-------------------------------
3574 #if defined HAVE_MPI_IO
3575  integer(kind=MPI_OFFSET_KIND) :: dispoct,nboct,posit,totoct
3576  integer :: statux(MPI_STATUS_SIZE)
3577 #endif
3578 ! *********************************************************************
3579 
3580  ierr=0
3581  if(.false.)write(std_out,*)wff%me,n1,spaceComm,xval
3582 #if defined HAVE_MPI_IO
3583  nboct = n1*wff%nbOct_int
3584  posit = wff%offwff
3585 
3586 !dispoct = sum (nboct, rank=0..me)
3587  if (spaceComm/=MPI_COMM_SELF) then
3588    call MPI_SCAN(nboct,dispoct,1,wff%offset_mpi_type,MPI_SUM,spaceComm,ierr)
3589    posit = posit+dispoct-nboct
3590  end if
3591  call MPI_FILE_WRITE_AT(wff%fhwff,posit,xval,n1,MPI_INTEGER,statux,ierr)
3592 !gather the bigest offset
3593 
3594  if (spaceComm/=MPI_COMM_SELF) then
3595    call xmpi_max(dispoct,totoct,spaceComm,ierr)
3596    !call MPI_ALLREDUCE(dispoct,totoct,1,wff%offset_mpi_type,MPI_MAX,spaceComm,ierr)
3597  else
3598    totoct=nboct
3599  end if
3600  wff%offwff = wff%offwff+totoct
3601 
3602 !Disable old code
3603 #endif
3604 
3605 end subroutine xderiveWrite_int1d

m_wffile/xderiveWrite_int2d [ Functions ]

[ Top ] [ m_wffile ] [ Functions ]

NAME

  xderiveWrite_int2d

FUNCTION

  Generic routine to read/write wf files with MPI I/O.
  Target: two-dimensional integer arrays.

INPUTS

  n1= first dimension of the array
  n2= second dimension of the array
  spaceComm= MPI communicator
  xval= data buffer array

OUTPUT

  ierr= exit status, a non-zero value meaning there is an error

SIDE EFFECTS

  wff= structured info for reading/writing the wavefunctions

PARENTS

CHILDREN

SOURCE

3636 subroutine xderiveWrite_int2d(wff,xval,n1,n2,spaceComm,ierr)
3637 
3638 
3639 !This section has been created automatically by the script Abilint (TD).
3640 !Do not modify the following lines by hand.
3641 #undef ABI_FUNC
3642 #define ABI_FUNC 'xderiveWrite_int2d'
3643 !End of the abilint section
3644 
3645  implicit none
3646 
3647 !Arguments ------------------------------------
3648  integer,intent(in) :: n1,n2,spaceComm
3649  integer,intent(out) :: ierr
3650  integer,intent(in):: xval(:,:)
3651  type(wffile_type),intent(inout) :: wff
3652 
3653 !Local variables-------------------------------
3654 #if defined HAVE_MPI_IO
3655  integer(kind=MPI_OFFSET_KIND) :: dispoct,nboct,posit,totoct
3656  integer  :: statux(MPI_STATUS_SIZE)
3657 #endif
3658 
3659 ! *********************************************************************
3660 
3661  ierr=0
3662  if(.false.)write(std_out,*)wff%me,n1,n2,spaceComm,xval
3663 #if defined HAVE_MPI_IO
3664  nboct = n1*n2*wff%nbOct_int
3665  posit = wff%offwff
3666 
3667 !dispoct = sum(nboct, rank=0..me)
3668  if (spaceComm/=MPI_COMM_SELF) then
3669    call MPI_SCAN(nboct,dispoct,1,wff%offset_mpi_type,MPI_SUM,spaceComm,ierr)
3670    posit = posit + dispoct-nboct
3671  end if
3672  call MPI_FILE_WRITE_AT(wff%fhwff,posit,xval,n1*n2,MPI_INTEGER,statux,ierr)
3673 !gather the biggest offset
3674  if (spaceComm/=MPI_COMM_SELF) then
3675    call xmpi_max(dispoct,totoct,spaceComm,ierr)
3676    !call MPI_ALLREDUCE(dispoct,totoct,1,wff%offset_mpi_type,MPI_MAX,spaceComm,ierr)
3677  else
3678    totoct=nboct
3679  end if
3680  wff%offwff = wff%offwff + totoct
3681 #endif
3682 
3683 end subroutine xderiveWrite_int2d

m_wffile/xderiveWrite_int2d_displ [ Functions ]

[ Top ] [ m_wffile ] [ Functions ]

NAME

  xderiveWrite_int2d_displ

FUNCTION

  Generic routine to read/write wf files with MPI I/O.
  Target: two-dimensional integer arrays.

INPUTS

  n1= first dimension of the array
  n2= second dimension of the array
  spaceComm= MPI communicator
  xval= data buffer array
  displace= number of elements for the offset

OUTPUT

  ierr= exit status, a non-zero value meaning there is an error

SIDE EFFECTS

  wff= structured info for reading/writing the wavefunctions

PARENTS

CHILDREN

SOURCE

3991 subroutine xderiveWrite_int2d_displ(wff,xval,n1,n2,spaceComm,displace,ierr)
3992 
3993 
3994 !This section has been created automatically by the script Abilint (TD).
3995 !Do not modify the following lines by hand.
3996 #undef ABI_FUNC
3997 #define ABI_FUNC 'xderiveWrite_int2d_displ'
3998 !End of the abilint section
3999 
4000  implicit none
4001 
4002 !Arguments ------------------------------------
4003  integer,intent(in) :: n1,n2,spaceComm
4004  integer,intent(out) :: ierr
4005  integer,intent(in):: displace(:),xval(:,:)
4006  type(wffile_type),intent(inout) :: wff
4007 
4008 !Local variables-------------------------------
4009 #if defined HAVE_MPI_IO
4010 !scalars
4011  integer :: filetype,i1,i2,ipos,nb,nbval,totsize,wfftempo
4012 !arrays
4013  integer :: statux(MPI_STATUS_SIZE)
4014  integer, allocatable :: buf_val(:),length1(:),type1(:),val(:)
4015  integer(kind=MPI_OFFSET_KIND),allocatable :: depl(:),depl1(:),depl_val(:)
4016 #endif
4017 
4018 ! *********************************************************************
4019 
4020  ierr=0
4021  if(.false.)write(std_out,*)wff%me,xval,n1,n2,spaceComm,displace
4022 
4023 #if defined HAVE_MPI_IO
4024  nb = n1*n2
4025  call xmpi_sum(nb,totsize,spaceComm,ierr)
4026  ABI_ALLOCATE(depl_val,(0:totsize-1))
4027  ABI_ALLOCATE(depl,(nb))
4028  ABI_ALLOCATE(buf_val,(0:totsize-1))
4029  ABI_ALLOCATE(val,(nb))
4030 
4031 !Map displacements
4032 !Put xval in a buffer at its position
4033  depl_val(0:totsize-1)=-1
4034  do i2=1,n2
4035    do i1=1,n1
4036 !    ipos location of xval(i1,i2) in the array associated with record to be written
4037      ipos=(displace(i2)-1)*n1 + i1-1
4038      buf_val(ipos) = xval(i1,i2)
4039      depl_val(ipos) = ipos
4040    end do
4041  end do
4042 !To save time, the location describe by array map must be in increasing order
4043  nbval=0
4044  do i1=0,totsize-1
4045    if (depl_val(i1)/=-1) then
4046      nbval=nbval+1
4047      val(nbval)=buf_val(i1)
4048      depl(nbval)=depl_val(i1)
4049    end if
4050  end do
4051 
4052 !Build MPI datatype for view
4053  ABI_ALLOCATE(length1,(nbval+2))
4054  ABI_ALLOCATE(depl1,(nbval+2))
4055  ABI_ALLOCATE(type1,(nbval+2))
4056  length1(1)=1;depl1(1)=0;type1(1)=MPI_LB
4057  do i1=2,nbval+1
4058    length1(i1) = 1
4059    depl1(i1)= depl(i1-1)*wff%nbOct_int
4060    type1(i1)= MPI_INTEGER
4061  end do
4062  length1(nbval+2)=1;depl1(nbval+2)=totsize*wff%nbOct_int;type1(nbval+2)=MPI_UB
4063  call xmpio_type_struct(nbval+2,length1,depl1,type1,filetype,ierr)
4064  call MPI_TYPE_COMMIT(filetype,ierr)
4065  ABI_DEALLOCATE(length1)
4066  ABI_DEALLOCATE(depl1)
4067  ABI_DEALLOCATE(type1)
4068 
4069 !Write data
4070  call MPI_FILE_OPEN(spaceComm,wff%fname,MPI_MODE_RDWR,MPI_INFO_NULL,wfftempo,ierr)
4071  ABI_CHECK_MPI(ierr, sjoin("MPI_FILE_OPEN:", wff%fname))
4072  call MPI_FILE_SET_VIEW(wfftempo,wff%offwff,MPI_BYTE,filetype,"native",MPI_INFO_NULL,ierr)
4073  call MPI_FILE_WRITE_ALL(wfftempo,val,nbval,MPI_INTEGER,statux,ierr)
4074  call MPI_FILE_CLOSE(wfftempo,ierr)
4075 
4076 !Update offset
4077  wff%offwff = wff%offwff + totsize*wff%nbOct_int
4078 
4079 !Free memory
4080  call MPI_TYPE_FREE(filetype,ierr)
4081  ABI_DEALLOCATE(depl)
4082  ABI_DEALLOCATE(depl_val)
4083  ABI_DEALLOCATE(buf_val)
4084  ABI_DEALLOCATE(val)
4085 #endif
4086 
4087 end subroutine xderiveWrite_int2d_displ

m_wffile/xmoveOff [ Functions ]

[ Top ] [ m_wffile ] [ Functions ]

NAME

  xmoveOff

FUNCTION

  In case of MPI I/O, move the offset of a WF file

INPUTS

  [n_int] = number if integers to skip
  [n_dp]  = number if double precision reals to skip
  [n_ch]  = number if characters to skip
  [n_mark]= number if record markers to skip

OUTPUT

SIDE EFFECTS

  wff=<type(wffile_type)>=structured info for reading/writing

PARENTS

      posdoppler

CHILDREN

SOURCE

610 subroutine xmoveOff(wff,n_int,n_dp,n_ch,n_mark)
611 
612 
613 !This section has been created automatically by the script Abilint (TD).
614 !Do not modify the following lines by hand.
615 #undef ABI_FUNC
616 #define ABI_FUNC 'xmoveOff'
617 !End of the abilint section
618 
619  implicit none
620 
621 !Arguments ------------------------------------
622  integer,intent(in),optional :: n_int,n_dp,n_ch,n_mark
623  type(wffile_type),intent(inout) :: wff
624 
625 ! *************************************************************************
626 
627 #if defined HAVE_MPI_IO
628  if (present(n_int) ) wff%offwff=wff%offwff+n_int *wff%nbOct_int
629  if (present(n_dp)  ) wff%offwff=wff%offwff+n_dp  *wff%nbOct_dp
630  if (present(n_ch)  ) wff%offwff=wff%offwff+n_ch  *wff%nbOct_ch
631  if (present(n_mark)) wff%offwff=wff%offwff+n_mark*wff%nbOct_recMarker
632 #else
633 !This section should not be used...
634  if (present(n_int) .and.(.false.)) write(std_out,*) n_int
635  if (present(n_dp)  .and.(.false.)) write(std_out,*) n_dp
636  if (present(n_ch)  .and.(.false.)) write(std_out,*) n_ch
637  if (present(n_mark).and.(.false.)) write(std_out,*) n_mark
638 #endif
639 
640 end subroutine xmoveOff

m_wffile/xmpi_read_int2d [ Functions ]

[ Top ] [ m_wffile ] [ Functions ]

NAME

  xmpi_read_int2d

FUNCTION

  Generic routine to read arrays with MPI I/O.
  Target: integer two-dimensional arrays.

INPUTS

  sc_mode=
    xmpio_single     ==> Local reading.
    xmpio_collective ==> Collective reading.
  spaceComm= MPI communicator

OUTPUT

  xval= data buffer array
  ierr= exit status, a non-zero value meaning there is an error

SIDE EFFECTS

  wff= structured info for reading/writing the wavefunctions

PARENTS

      rwwf

CHILDREN

SOURCE

3397 subroutine xmpi_read_int2d(wff,xval,spaceComm,sc_mode,ierr)
3398 
3399 
3400 !This section has been created automatically by the script Abilint (TD).
3401 !Do not modify the following lines by hand.
3402 #undef ABI_FUNC
3403 #define ABI_FUNC 'xmpi_read_int2d'
3404 !End of the abilint section
3405 
3406  implicit none
3407 
3408 !Arguments ------------------------------------
3409 !scalars
3410  integer,intent(in) :: spaceComm,sc_mode
3411  integer,intent(out) :: ierr
3412  type(wffile_type),intent(inout) :: wff
3413 !array
3414  integer,intent(out) :: xval(:,:)
3415 
3416 !Local variables-------------------------------
3417  integer :: n1,n2
3418 #ifdef HAVE_MPI_IO
3419  integer(kind=MPI_OFFSET_KIND) :: delim_record,nboct,posit,totoct
3420  character(len=500) :: msg
3421 !arrays
3422  integer :: statux(MPI_STATUS_SIZE)
3423 #endif
3424 
3425 ! *********************************************************************
3426 
3427  ierr=0
3428  n1 = SIZE(xval,DIM=1)
3429  n2 = SIZE(xval,DIM=2)
3430 
3431 #ifdef HAVE_MPI_IO
3432  nboct = wff%nbOct_int * n1 *n2
3433  posit = wff%offwff
3434  delim_record = posit - wff%off_recs + wff%lght_recs - wff%nbOct_recMarker
3435 
3436  if (delim_record >= nboct) then
3437 
3438    select case (sc_mode)
3439      case (xmpio_single)
3440        call MPI_FILE_READ_AT(wff%fhwff,posit,xval,n1*n2,MPI_INTEGER,statux,ierr)
3441 
3442      case (xmpio_collective)
3443        call MPI_FILE_READ_AT_ALL(wff%fhwff,posit,xval,n1*n2,MPI_INTEGER,statux,ierr)
3444 
3445      case default
3446        write(msg,('(a,i0)'))" Wrong value for sc_mode: ",sc_mode
3447        MSG_ERROR(msg)
3448    end select
3449 
3450    totoct=nboct
3451  else
3452    write(msg,('(a,2(i0,1x))'))" delim_record < nboct: ",delim_record,nboct
3453    MSG_WARNING(msg)
3454    ierr=MPI_ERR_UNKNOWN
3455    totoct=0
3456  end if
3457 !
3458 !Increment the offset.
3459  wff%offwff=wff%offwff + totoct
3460 #endif
3461 
3462  RETURN
3463  ABI_UNUSED(xval(1,1))
3464  ABI_UNUSED((/wff%me,spaceComm,sc_mode/))
3465 
3466 end subroutine xmpi_read_int2d

m_wffile/xnullifyOff [ Functions ]

[ Top ] [ m_wffile ] [ Functions ]

NAME

  xnullifyOff

FUNCTION

  In case of MPI I/O, nullify the offset of a WF file

INPUTS

OUTPUT

SIDE EFFECTS

  wff=<type(wffile_type)>=structured info for reading/writing

PARENTS

      m_wffile

CHILDREN

SOURCE

555 subroutine xnullifyOff(wff)
556 
557 
558 !This section has been created automatically by the script Abilint (TD).
559 !Do not modify the following lines by hand.
560 #undef ABI_FUNC
561 #define ABI_FUNC 'xnullifyOff'
562 !End of the abilint section
563 
564  implicit none
565 
566 !Arguments ------------------------------------
567  type(wffile_type),intent(inout) :: wff
568 
569 ! *************************************************************************
570 
571 #if defined HAVE_MPI_IO
572  wff%offwff    = 0
573  wff%off_recs  = 0
574  wff%lght_recs = 0
575 #endif
576 
577  RETURN
578  ABI_UNUSED(wff%me)
579 
580 end subroutine xnullifyOff