scnc
/
quantum-espresso
mirror of https://gitlab.com/QEF/q-e.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Changed the "open_buffer" call. It is no longer needed to specify the 

maximum number of record. Better to specify with a flag if writing to a
RAM buffer than using tricks such as negative units. BEWARE: may break 
things *but it shouldn't)


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@10056 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
giannozz 2013-03-13 21:17:31 +00:00
parent 007a1cfcc9
commit 2a4b284d07
11 changed files with 76 additions and 119 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
CPV/src/cp_restart.f90
View File

@ -918,11 +918,9 @@ MODULE cp_restart
wfc_dir = TRIM( restart_dir( tmp_dir, ndw ) ) // '/'
wfc_dir = TRIM( kpoint_dir( wfc_dir, 1 ) ) // '/'
!
iunwfc = 10
nwordwfc = SIZE( c02 )
!
CALL diropn ( iunwfc, 'wfc', 2*nwordwfc, exst, wfc_dir )
!
CALL davcio ( c02, 2*nwordwfc, iunwfc, 1, +1 ) ! save wave funct
CALL davcio ( cm2, 2*nwordwfc, iunwfc, 2, +1 ) ! save wave funct
!
@ -1819,7 +1817,6 @@ MODULE cp_restart
wfc_dir = TRIM( restart_dir( tmp_dir, ndr ) ) // '/'
wfc_dir = TRIM( kpoint_dir( wfc_dir, 1 ) ) // '/'
!
iunwfc = 10
nwordwfc = SIZE( c02 )
!
CALL diropn ( iunwfc, 'wfc', 2*nwordwfc, exst, wfc_dir )

4
Doc/release-notes
View File

@ -36,6 +36,10 @@ Fixed in svn version:
Incompatible changes in svn version:
* calls to "find_equiv_sites" and "writemodes" changed (fixed dimension
"nax" removed)
* call to "open_buffer" changed: unit must be a valid fortran unit > 0;
max number of records is no longer specified; a new flag explicitly
specifies if writing to RAM buffer is required. Functionalities of
Modules/buffers.f90 have been considerably modified and extended.
New in 5.0.2 version:

74
PW/src/buffers.f90
View File

@ -452,25 +452,23 @@ Module buffers
contains
!----------------------------------------------------------------------------
SUBROUTINE open_buffer (unit, extension, nword, maxrec, exst)
SUBROUTINE open_buffer (unit, extension, nword, io_level, exst)
!---------------------------------------------------------------------------
!
! unit >=0 : connect unit "unit" to file "wfc_fdir"/"prefix"."extension"
! for direct I/O access, with record length = nword complex numbers;
! on output, exst=T(F) if the file (does not) exists
! io_level>0: connect unit "unit" to file "wfc_fdir"/"prefix"."extension"
! for direct I/O access, with record length = nword complex numbers;
! on output, exst=T(F) if the file (does not) exists
!
! unit < 0 : un addition to opening unit "abs(unit)" as above, open a
! buffer for storing records of length nword complex numbers;
! on output, exst=T(F) if the buffer is already allocated
!
! fIXME: maxrec is no longer used and should be removed
! io_level=0: in addition to opening unit "unit" as above, open a
! buffer for storing records of length nword complex numbers;
! on output, exst=T(F) if the buffer is already allocated
!
USE io_files, ONLY : diropn, wfc_dir
!
IMPLICIT NONE
!
CHARACTER(LEN=*), INTENT(IN) :: extension
INTEGER, INTENT(IN) :: unit, nword, maxrec
INTEGER, INTENT(IN) :: unit, nword, io_level
LOGICAL, INTENT(OUT) :: exst
!
INTEGER :: ierr
@ -482,11 +480,11 @@ contains
IF (extension == ' ') &
CALL errore ('open_buffer','filename extension not given',1)
!
CALL diropn ( abs(unit), extension, 2*nword, exst, wfc_dir )
CALL diropn ( unit, extension, 2*nword, exst, wfc_dir )
nunits = nunits + 1
!
IF ( unit < 0 ) THEN
ierr = buiol_open_unit ( abs(unit), nword )
IF ( io_level <= 0 ) THEN
ierr = buiol_open_unit ( unit, nword )
IF ( ierr > 0 ) CALL errore ('open_buffer', ' cannot open unit', 2)
exst = ( ierr == -1 )
IF (exst) THEN
@ -502,9 +500,9 @@ contains
SUBROUTINE save_buffer( vect, nword, unit, nrec )
!---------------------------------------------------------------------------
!
! ... copy vect(1:nword) into the "nrec"-th record of
! ... - a previously allocated buffer, if unit < 0
! ... - a previously opened direct-access file with unit >= 0
! ... copy vect(1:nword) into the "nrec"-th record of a previously
! ... allocated buffer / opened direct-access file, depending upon
! ... how "open_buffer" was called
!
IMPLICIT NONE
!
@ -512,10 +510,11 @@ contains
COMPLEX(DP), INTENT(IN) :: vect(nword)
INTEGER :: ierr
!
IF ( unit < 0 ) THEN
ierr = buiol_write_record ( abs(unit), nword, nrec, vect )
ierr = buiol_check_unit (unit)
IF( ierr > 0 ) THEN
ierr = buiol_write_record ( unit, nword, nrec, vect )
if ( ierr > 0 ) &
CALL errore ('save_buffer', 'cannot write record', ABS(unit))
CALL errore ('save_buffer', 'cannot write record', unit)
#ifdef __DEBUG
print *, 'save_buffer: record', nrec, ' written to unit', unit
#endif
@ -529,9 +528,9 @@ contains
SUBROUTINE get_buffer( vect, nword, unit, nrec )
!---------------------------------------------------------------------------
!
! ... copy vect(1:nword) from the "nrec"-th record of
! ... - a previously allocated buffer, if unit < 0
! ... - a previously opened direct-access file with unit >= 0
! ... copy vect(1:nword) from the "nrec"-th record of a previously
! ... allocated buffer / opened direct-access file, depending upon
! ... how "open_buffer" was called
!
IMPLICIT NONE
!
@ -539,18 +538,19 @@ contains
COMPLEX(DP), INTENT(OUT) :: vect(nword)
INTEGER :: ierr
!
IF ( unit < 0 ) THEN
ierr = buiol_read_record ( abs(unit), nword, nrec, vect )
ierr = buiol_check_unit (unit)
IF( ierr > 0 ) THEN
ierr = buiol_read_record ( unit, nword, nrec, vect )
#ifdef __DEBUG
print *, 'get_buffer: record', nrec, ' read from unit', unit
#endif
if ( ierr < 0 ) then
! record not found: read from file ....
CALL davcio ( vect, 2*nword, abs(unit), nrec, -1 )
CALL davcio ( vect, 2*nword, unit, nrec, -1 )
! ... and save to memory
ierr = buiol_write_record ( abs(unit), nword, nrec, vect )
ierr = buiol_write_record ( unit, nword, nrec, vect )
if ( ierr /= 0 ) CALL errore ('get_buffer', &
'cannot store record in memory', ABS(unit))
'cannot store record in memory', unit)
#ifdef __DEBUG
print *, 'get_buffer: record', nrec, ' read from file', unit
#endif
@ -566,9 +566,10 @@ contains
SUBROUTINE close_buffer ( unit, status )
!
! unit >=0 : close unit with status "status" ('keep' or 'delete')
! unit < 0 : deallocate buffer; if "status='keep'" save to file
! (using saved value of extension)
! close unit with status "status" ('keep' or 'delete') OR
! deallocate buffer; if "status='keep'" save to file
! (using saved value of extension)
! ... depending upon how "open_buffer" was called
!
USE io_files, ONLY : diropn
!
@ -581,27 +582,28 @@ contains
INTEGER :: n, ierr, nrec, nword
LOGICAL :: opnd
!
IF ( unit < 0 ) THEN
ierr = buiol_check_unit (unit)
IF( ierr > 0 ) THEN
if ( status == 'keep' .or. status == 'KEEP' ) then
!
nword = buiol_check_unit ( abs(unit) )
nword = buiol_check_unit ( unit )
allocate (vect(nword))
n = 1
10 continue
ierr = buiol_read_record ( abs(unit), nword, n, vect )
ierr = buiol_read_record ( unit, nword, n, vect )
IF ( ierr /= 0 ) go to 20
CALL davcio ( vect, 2*nword, abs(unit), n, +1 )
CALL davcio ( vect, 2*nword, unit, n, +1 )
n = n+1
go to 10
20 deallocate (vect)
end if
ierr = buiol_close_unit ( abs(unit) )
ierr = buiol_close_unit ( unit )
if ( ierr < 0 ) &
CALL errore ('close_buffer', 'error closing', ABS(unit))
#ifdef __DEBUG
print *, 'close_buffer: unit ',unit, 'closed'
#endif
CLOSE( UNIT = abs(unit), STATUS = status )
CLOSE( UNIT = unit, STATUS = status )
ELSE
INQUIRE( UNIT = unit, OPENED = opnd )
IF ( opnd ) CLOSE( UNIT = unit, STATUS = status )

5
PW/src/read_file.f90
View File

@ -26,6 +26,7 @@ SUBROUTINE read_file()
USE dfunct, ONLY : newd
USE ldaU, ONLY : lda_plus_u, U_projection
USE pw_restart, ONLY : pw_readfile
USE control_flags, ONLY : io_level
!
IMPLICIT NONE
INTEGER :: ierr
@ -37,10 +38,12 @@ SUBROUTINE read_file()
!
! ... Open unit iunwfc, for Kohn-Sham orbitals - we assume that wfcs
! ... have been written to tmp_dir, not to a different directory!
! ... io_level = 1 so that a real file is opened
!
wfc_dir = tmp_dir
nwordwfc = nbnd*npwx*npol
CALL open_buffer ( iunwfc, 'wfc', nwordwfc, nks, exst )
io_level = 1
CALL open_buffer ( iunwfc, 'wfc', nwordwfc, io_level, exst )
!
! ... Read orbitals, write them in 'distributed' form to iunwfc
!

47
PW/src/restart_from_file.f90
View File

@ -17,23 +17,18 @@ SUBROUTINE restart_from_file
IMPLICIT NONE
!
CHARACTER(LEN=20) :: where_restart
! parameter indicating from where to restart
INTEGER :: ios
!
! ... restart not required: delete restart file if present, return
!
IF ( .NOT. restart ) THEN
!
!WRITE( UNIT = stdout, &
! & FMT = '(/5X,"RECOVER from restart file has been", &
! & " switched off on input")' )
!
IF ( ionode ) THEN
!
#ifdef DEBUG
WRITE( UNIT = stdout, &
& FMT = '(/5X,"RECOVER from restart file has been", &
& " switched off on input")' )
#endif
IF ( ionode ) &
CALL delete_if_present( TRIM(tmp_dir) // TRIM(prefix) // '.restart' )
!
END IF
!
RETURN
!
END IF
@ -43,12 +38,7 @@ SUBROUTINE restart_from_file
!
iunres = 1
!
IF ( ionode ) THEN
!
CALL seqopn( iunres, 'restart', 'UNFORMATTED', restart )
!
END IF
!
IF ( ionode ) CALL seqopn( iunres, 'restart', 'UNFORMATTED', restart )
CALL mp_bcast ( restart, ionode_id )
!
IF ( .NOT. restart ) THEN
@ -56,13 +46,7 @@ SUBROUTINE restart_from_file
WRITE( UNIT = stdout, &
& FMT = '(/5X,"RECOVER from restart file failed:", &
& " file not found")')
!
IF ( ionode ) THEN
!
CLOSE( UNIT = iunres, STATUS = 'DELETE' )
!
END IF
!
IF ( ionode ) CLOSE( UNIT = iunres, STATUS = 'DELETE' )
RETURN
!
END IF
@ -70,14 +54,10 @@ SUBROUTINE restart_from_file
IF ( ionode ) THEN
!
WRITE( UNIT = stdout, FMT = '(/5X,"read information from restart file")' )
!
READ( iunres, IOSTAT = ios ) where_restart
!
IF ( where_restart /= 'ELECTRONS' .AND. where_restart /= 'IONS' ) THEN
!
IF ( where_restart /= 'ELECTRONS' .AND. where_restart /= 'IONS' ) &
ios = 1001
!
END IF
!
! ... close the file for later use
!
CLOSE( UNIT = iunres, STATUS = 'KEEP' )
@ -88,13 +68,10 @@ SUBROUTINE restart_from_file
CALL mp_bcast ( where_restart, ionode_id )
!
IF ( ios == 0 ) THEN
!
WRITE( UNIT = stdout, FMT = '(5X,"Restarting in ",A)' ) where_restart
!
ELSE
!
CALL errore( 'restart_from_file', 'Cannot restart from here: '//TRIM(where_restart), ios)
!
CALL errore( 'restart_from_file', &
'Cannot restart from here: '//TRIM(where_restart), ios)
END IF
!
RETURN

11
PW/src/wannier_init.f90
View File

@ -30,7 +30,7 @@ SUBROUTINE wannier_init(hwwa)
LOGICAL,INTENT(IN) :: hwwa ! have we Wannier already?
LOGICAL :: exst = .FALSE.,opnd
INTEGER :: i
INTEGER :: i, io_level
ALLOCATE(pp(nwan,nbnd))
ALLOCATE(wan_in(nwan,nspin))
@ -62,8 +62,9 @@ SUBROUTINE wannier_init(hwwa)
!now open files to store projectors and wannier functions
nwordwpp = nwan*nbnd*npol
nwordwf = nwan*npwx*npol
CALL open_buffer( iunwpp, 'wproj', nwordwpp, nks, exst )
CALL open_buffer( iunwf, 'wwf', nwordwf, nks, exst )
io_level = 1
CALL open_buffer( iunwpp, 'wproj', nwordwpp, io_level, exst )
CALL open_buffer( iunwf, 'wwf', nwordwf, io_level, exst )
! For atomic wavefunctions
INQUIRE( UNIT = iunigk, OPENED = opnd )
@ -74,9 +75,9 @@ SUBROUTINE wannier_init(hwwa)
nwordatwfc = 2*npwx*natomwfc*npol
INQUIRE( UNIT = iunat, OPENED = opnd )
IF(.NOT. opnd) CALL open_buffer( iunat, 'atwfc', nwordatwfc/2, nks, exst )
IF(.NOT. opnd) CALL open_buffer( iunat, 'atwfc', nwordatwfc/2,io_level,exst )
INQUIRE( UNIT = iunsat, OPENED = opnd )
IF(.NOT. opnd) CALL open_buffer( iunsat, 'satwfc', nwordatwfc/2, nks, exst )
IF(.NOT. opnd) CALL open_buffer( iunsat,'satwfc',nwordatwfc/2,io_level,exst )
RETURN
!

10
PW/src/wfcinit.f90
View File

@ -44,15 +44,9 @@ SUBROUTINE wfcinit()
CALL orthoatwfc()
!
! ... open files/buffer for wavefunctions (nwordwfc set in openfil)
! ... iunwfc= 10: read/write wfc from/to file
! ... iunwfc=-10: copy wfc to/from RAM
! ... io_level > 1 : open file, otherwise: open buffer
!
IF ( io_level > 0 ) THEN
iunwfc = 10
ELSE
iunwfc =-10
END IF
CALL open_buffer( iunwfc, 'wfc', nwordwfc, nks, exst )
CALL open_buffer( iunwfc, 'wfc', nwordwfc, io_level, exst )
!
! ... now the various possible wavefunction initializations
! ... first a check: is "tmp_dir"/"prefix".wfc found on disk?

20
PWCOND/src/openfil_cond.f90
View File

@ -15,7 +15,6 @@ SUBROUTINE openfil_cond()
USE kinds, ONLY : DP
USE io_global, ONLY : stdout
USE wvfct, ONLY : nbnd, npwx
USE klist, ONLY : nks
USE io_files, ONLY : prefix, iunpun, iunat, iunsat, iunwfc, iunigk, &
nwordwfc, nwordatwfc, iunefield, &
iunefieldm, iunefieldp
@ -30,18 +29,10 @@ SUBROUTINE openfil_cond()
!
! ... nwordwfc is the record length (IN COMPLEX WORDS)
! ... for the direct-access file containing wavefunctions
! ... io_level > 0 : open a file; io_level <= 0 : open a buffer
!
nwordwfc = nbnd*npwx*npol
!
! ... iunwfc= 10: read/write wfc from/to file
! ... iunwfc=-10: copy wfc to/from RAM
!
IF ( io_level > 0 ) THEN
iunwfc = 10
ELSE
iunwfc =-10
END IF
CALL open_buffer( iunwfc, 'wfc', nwordwfc, nks, exst )
CALL open_buffer( iunwfc, 'wfc', nwordwfc, io_level, exst )
!
RETURN
!
@ -56,16 +47,9 @@ SUBROUTINE closefil_cond()
USE kinds, ONLY : DP
USE io_files, ONLY : iunwfc
USE buffers, ONLY : close_buffer
USE control_flags, ONLY : io_level
!
IMPLICIT NONE
!
!
IF ( io_level > 0 ) THEN
iunwfc = 10
ELSE
iunwfc =-10
END IF
CALL close_buffer( iunwfc, 'keep' )
!
RETURN

2
TDDFPT/src/lr_read_wf.f90
View File

@ -64,7 +64,7 @@ SUBROUTINE lr_read_wf()
evc(:,:)=evc0(:,:,1)
IF ( dft_is_hybrid() ) THEN
CALL open_buffer ( iunwfc, 'wfc', nwordwfc, nks, exst )
CALL open_buffer ( iunwfc, 'wfc', nwordwfc, io_level, exst )
CALL exx_grid_init()
CALL exx_div_check()
CALL exx_restart(.true.)

13
XSpectra/src/gipaw_module.f90
View File

@ -248,18 +248,13 @@ CONTAINS
USE control_flags, ONLY : io_level
IMPLICIT NONE
LOGICAL :: exst
!
! ... nwordwfc is the record length (IN COMPLEX WORDS)
! ... for the direct-access file containing wavefunctions
! ... io_level > 0 : open a file; io_level <= 0 : open a buffer
!
nwordwfc = nbnd*npwx*npol
! ... iunwfc=10: read/write wfc from/to file
! ... iunwfc=-1: copy wfc to/from RAM
IF ( io_level > 0 ) THEN
iunwfc = 10
ELSE
iunwfc = -1
END IF
CALL open_buffer( iunwfc, 'wfc', nwordwfc, nks, exst )
CALL open_buffer( iunwfc, 'wfc', nwordwfc, io_level, exst )
! ... Needed for LDA+U
! ... iunat contains the (orthogonalized) atomic wfcs

4
XSpectra/src/read_file_xspectra.f90
View File

@ -15,7 +15,7 @@ SUBROUTINE read_file_xspectra(xread_wf)
!
USE kinds, ONLY : DP
USE io_global, ONLY : stdout
USE control_flags, ONLY : gamma_only
USE control_flags, ONLY : gamma_only, io_level
USE ions_base, ONLY : nat, nsp, ityp, tau, if_pos, extfor
USE basis, ONLY : natomwfc
USE cell_base, ONLY : tpiba2, alat,omega, at, bg, ibrav
@ -298,7 +298,7 @@ SUBROUTINE read_file_xspectra(xread_wf)
nwordwfc = nbnd*npwx*npol
!
CALL open_buffer ( iunwfc, 'wfc', nwordwfc, nks, exst )
CALL open_buffer ( iunwfc, 'wfc', nwordwfc, io_level, exst )
!
CALL pw_readfile( 'wave', ierr )
!