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

iotk removed from PWCOND. Restart files are written as plain text files. 

May or may not work.
This commit is contained in:
giannozz 2020-03-03 22:05:45 +01:00
parent ff52e3cffd
commit 06ba618652
2 changed files with 71 additions and 345 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

415
PWCOND/src/cond_restart.f90
View File

@ -13,10 +13,8 @@ MODULE cond_restart
! ... this module contains methods to read and write data saved by the
! ballistic conductance code pwcond.x to restart smoothly
!
USE iotk_module
!
USE kinds, ONLY : DP
USE io_files, ONLY : tmp_dir, iunpun, create_directory
USE io_files, ONLY : tmp_dir, create_directory
USE io_global, ONLY : ionode, ionode_id
USE mp_images, ONLY : intra_image_comm
USE mp, ONLY : mp_bcast
@ -32,16 +30,6 @@ MODULE cond_restart
!
INTEGER, PRIVATE :: iunout
!
! variables to describe qexml current version
! and back compatibility
!
CHARACTER(len=256) :: qexml_version = ' ' ! the format of the current qexml datafile
LOGICAL :: qexml_version_before_1_4_0 = .FALSE.
LOGICAL :: qexml_version_init = .FALSE. ! whether the fmt has been read or not
CHARACTER(LEN=13) :: xmlpun = 'data-file.xml'
CHARACTER(iotk_attlenx) :: attr
!
!
CONTAINS
!
!------------------------------------------------------------------------
@ -58,150 +46,69 @@ MODULE cond_restart
REAL(DP), INTENT(IN), OPTIONAL :: tcurr
!
CHARACTER(LEN=256) :: dirname, filename
INTEGER :: ierr
INTEGER :: ierr, ik
CHARACTER(LEN=6), EXTERNAL :: int_to_char
INTEGER, external :: find_free_unit
! look for an empty unit for transmission files,
! (while info file goes in iunpun defined in io_files)
IF ( ionode ) CALL iotk_free_unit(iunout, ierr)
IF ( ionode ) iunout = find_free_unit( )
!
CALL mp_bcast(ierr, ionode_id, intra_image_comm)
!
CALL errore('cond_writefile ', 'no free units to write ', ierr)
!
dirname = TRIM(tmp_dir) // TRIM(tran_prefix) // '.cond_save'
!
! create the main restart directory
CALL create_directory(dirname)
dirname = TRIM(tmp_dir) // TRIM(tran_prefix)
!
! open the restart file
IF ( ionode ) THEN
!
! open XML descriptor
ierr=0
IF ( what=='init' ) THEN
CALL iotk_open_write(iunpun, FILE=TRIM(dirname) // '/' // &
TRIM(xmlpun), BINARY=.FALSE., IERR=ierr)
filename = TRIM(dirname) // '.rec'
ELSEIF ( what=='tran' ) THEN
filename = TRIM(dirname) // '/' // tk_file // '_k' // &
TRIM(int_to_char(kcurr)) // '_e' // TRIM(int_to_char(ecurr))
CALL iotk_open_write(iunout, FILE=TRIM(filename), &
BINARY=.FALSE., IERR=ierr)
filename = TRIM(dirname) // '_' // tk_file // '_k' // &
TRIM(int_to_char(kcurr)) // '_e' // TRIM(int_to_char(ecurr))
ELSE
CALL errore('cond_writefile','unknown what',1)
ENDIF
open (iunout, FILE=filename, FORM='formatted', IOSTAT=ierr)
!
END IF
!
CALL mp_bcast(ierr, ionode_id, intra_image_comm)
!
CALL errore('cond_writefile ', &
'cannot open xml_recover file for writing', ierr )
'cannot open recover file for writing', ierr )
!
IF ( ionode ) THEN
!
! here we start writing the cond-punch-file
IF ( what=='init' ) THEN
!
CALL iotk_write_begin( iunpun, "HEADER" )
WRITE(iunout,"('NUMBER_OF_ENERGIES')")
WRITE(iunout,*) nenergy
WRITE(iunout,"('ENERGY_LIST')")
WRITE(iunout,*) earr(:)
!
CALL iotk_write_attr(attr, "NAME","QEXML", FIRST=.true.)
CALL iotk_write_attr(attr, "VERSION","1.4.0" )
CALL iotk_write_empty( iunpun, "FORMAT", ATTR=attr )
!
CALL iotk_write_attr(attr, "NAME","PWCOND", FIRST=.true.)
CALL iotk_write_attr(attr, "VERSION",TRIM(version_number) )
CALL iotk_write_empty( iunpun, "CREATOR", ATTR=attr )
!
CALL iotk_write_end( iunpun, "HEADER" )
!
CALL write_elist(nenergy, earr)
!
CALL write_klist(nkpts, xyk, wkpt)
!
CALL iotk_close_write(iunpun)
WRITE(iunout,"('NUMBER_OF_K-POINTS')")
WRITE(iunout,*) nkpts
DO ik = 1, nkpts
!
WRITE(iunout,"('K-POINT',i4)") ik
WRITE(iunout,*) xyk(:,ik)
WRITE(iunout,*) wkpt(ik)
!
END DO
!
ELSEIF ( what=='tran' ) THEN
!
CALL write_transmission(ecurr, kcurr, tcurr)
!
CALL iotk_close_write(iunout)
WRITE(iunout,"('PARTIAL_TRANSMISSION')")
WRITE(iunout,*) ecurr, kcurr, tcurr
!
ENDIF
!
CLOSE (unit=iunout, status='keep')
!
ENDIF
RETURN
!
END SUBROUTINE cond_writefile
!
!
!------------------------------------------------------------------------
SUBROUTINE write_elist( ne, elist )
!------------------------------------------------------------------------
!
INTEGER, INTENT(IN) :: ne
REAL(DP), INTENT(IN) :: elist(:)
!
!
CALL iotk_write_begin( iunpun, "SCATTERING_ENERGIES" )
!
CALL iotk_write_dat( iunpun, "NUMBER_OF_ENERGIES", ne )
!
CALL iotk_write_attr( attr, "UNITS", "eV", FIRST = .TRUE. )
!
CALL iotk_write_dat( iunpun, "ENERGY_LIST", elist(:), ATTR=attr, COLUMNS=1 )
!
CALL iotk_write_end( iunpun, "SCATTERING_ENERGIES" )
!
END SUBROUTINE write_elist
!
!------------------------------------------------------------------------
SUBROUTINE write_klist( nk, klist, wk )
!------------------------------------------------------------------------
!
INTEGER, INTENT(IN) :: nk
REAL(DP), INTENT(IN) :: klist(:,:), wk(:)
!
INTEGER :: ik
!
CALL iotk_write_begin( iunpun, "K-POINTS_MESH" )
!
CALL iotk_write_attr( attr, "UNITS", "2 pi / a", FIRST = .TRUE. )
CALL iotk_write_empty( iunpun, "UNITS_FOR_K-POINTS", attr )
!
CALL iotk_write_dat( iunpun, "NUMBER_OF_K-POINTS", nk )
!
DO ik = 1, nk
!
CALL iotk_write_attr( attr, "XY", klist(:,ik), FIRST = .TRUE. )
!
CALL iotk_write_attr( attr, "WEIGHT", wk(ik) )
!
CALL iotk_write_empty( iunpun, "K-POINT" // &
& TRIM( iotk_index(ik) ), attr )
!
END DO
!
CALL iotk_write_end( iunpun, "K-POINTS_MESH" )
!
END SUBROUTINE write_klist
!
!------------------------------------------------------------------------
SUBROUTINE write_transmission( ie, ik, t )
!------------------------------------------------------------------------
!
INTEGER, INTENT(IN) :: ie, ik
REAL(DP), INTENT(IN) :: t
!
CALL iotk_write_dat( iunout, "PARTIAL_TRANSMISSION", t )
!
END SUBROUTINE write_transmission
!
!
!------------------------------------------------------------------------
SUBROUTINE cond_readfile( what, ierr, kcurr, ecurr, tcurr )
!------------------------------------------------------------------------
@ -213,261 +120,81 @@ MODULE cond_restart
INTEGER, INTENT(IN), OPTIONAL :: ecurr, kcurr
REAL(DP), INTENT(OUT), OPTIONAL :: tcurr
INTEGER, INTENT(OUT) :: ierr
!
CHARACTER(LEN=256) :: dirname
CHARACTER(LEN=256) :: dirname, filename
CHARACTER(LEN=6), EXTERNAL :: int_to_char
INTEGER, external :: find_free_unit
INTEGER :: ne, ie, nk, ik
LOGICAL :: exist
REAL(DP) :: elist(nenergy), kpt(2), wk
!
ierr = 0
!
dirname = TRIM( tmp_dir ) // TRIM( tran_prefix ) // '.cond_save'
!
! look for an empty unit for transmission files
IF (ionode) CALL iotk_free_unit( iunout, ierr )
IF (ionode) iunout = find_free_unit( )
!
CALL mp_bcast( ierr,ionode_id,intra_image_comm )
dirname = TRIM(tmp_dir) // TRIM(tran_prefix)
!
CALL errore( 'cond_readfile', &
'no free units to read restart file', ierr )
!
SELECT CASE( what )
CASE( 'init' )
!
qexml_version_init = .FALSE.
CALL read_header( dirname, ierr )
IF (ierr .NE. 0 ) CALL errore('cond_readfile', &
'error while reading header of info file',ierr)
!
CALL read_elist( dirname, nenergy, earr, ierr )
IF (ierr .NE. 0 ) CALL errore('cond_readfile', &
'error while reading energies from info file',ierr)
!
CALL read_klist( dirname, nkpts, xyk, wkpt, ierr )
IF (ierr .NE. 0 ) CALL errore('cond_readfile', &
'error while reading k-points from info file',ierr)
!
CASE( 'tran' )
!
CALL read_transmission( dirname, kcurr, ecurr, tcurr, ierr )
! the corresponding file may not be present for all (e,k)
!
END SELECT
!
RETURN
!
END SUBROUTINE cond_readfile
!
!------------------------------------------------------------------------
SUBROUTINE read_header( dirname, ierr )
!------------------------------------------------------------------------
!
! ... this routine reads the format version of the current xml datafile
!
USE parser, ONLY : version_compare
IMPLICIT NONE
!
CHARACTER(LEN=*), INTENT(IN) :: dirname
INTEGER, INTENT(OUT) :: ierr
ierr = 0
IF ( qexml_version_init ) RETURN
!
IF ( ionode ) &
CALL iotk_open_read( iunpun, FILE = TRIM( dirname ) // '/' // &
& TRIM( xmlpun ), IERR = ierr )
!
CALL mp_bcast( ierr, ionode_id, intra_image_comm )
!
IF ( ierr.NE.0 ) RETURN
!
IF ( ionode ) THEN
!
CALL iotk_scan_begin( iunpun, "HEADER" )
!
CALL iotk_scan_empty( iunpun, "FORMAT", ATTR=attr )
!
CALL iotk_scan_attr( attr, "VERSION", qexml_version )
!
qexml_version_init = .TRUE.
!
CALL iotk_scan_end( iunpun, "HEADER" )
!
CALL iotk_close_read( iunpun )
!
IF ( what=='init' ) THEN
filename = TRIM(dirname) // '.rec'
ELSEIF ( what=='tran' ) THEN
filename = TRIM(dirname) // '_' // tk_file // '_k' // &
TRIM(int_to_char(kcurr)) // '_e' // TRIM(int_to_char(ecurr))
ELSE
CALL errore('cond_readfile','unknown what',1)
ENDIF
!
CALL mp_bcast( qexml_version, ionode_id, intra_image_comm )
CALL mp_bcast( qexml_version_init, ionode_id, intra_image_comm )
INQUIRE (FILE=filename, EXIST=exist )
IF ( .NOT.exist) CALL errore('cond_readfile','file not found',1)
OPEN (iunout, FILE=filename, FORM='formatted', STATUS='old', IOSTAT=ierr)
!
! init logical variables for versioning
!
qexml_version_before_1_4_0 = .FALSE.
!
IF ( TRIM( version_compare( qexml_version, "1.4.0" )) == "older" ) &
qexml_version_before_1_4_0 = .TRUE.
!
RETURN
END SUBROUTINE read_header
!
!------------------------------------------------------------------------
SUBROUTINE read_elist( dirname, ne, elist, ierr )
!------------------------------------------------------------------------
!
CHARACTER(LEN=*), INTENT(IN) :: dirname
INTEGER, INTENT(IN) :: ne
REAL(DP), INTENT(IN) :: elist(:)
INTEGER, INTENT(OUT) :: ierr
! local
INTEGER :: ne_, ie
REAL(DP) :: elist_(ne)
!
ierr = 0
!
IF ( ionode ) &
CALL iotk_open_read( iunpun, FILE = TRIM( dirname ) // '/' // &
& TRIM( xmlpun ), IERR = ierr )
!
CALL mp_bcast( ierr, ionode_id, intra_image_comm )
!
IF ( ierr.NE.0 ) RETURN
!
IF ( ionode ) THEN
IF ( what=='init' ) THEN
!
CALL iotk_scan_begin( iunpun, "SCATTERING_ENERGIES" )
!
CALL iotk_scan_dat( iunpun, "NUMBER_OF_ENERGIES", ne_ )
IF ( ne_.NE.ne ) ierr = 1
ENDIF
!
CALL mp_bcast( ierr, ionode_id, intra_image_comm )
IF ( ierr .NE. 0 ) RETURN
!
IF ( ionode ) THEN
CALL iotk_scan_dat( iunpun, "ENERGY_LIST", elist_ )
READ(iunout,*)
READ(iunout,*) ne
IF ( ne .NE. nenergy ) ierr = 1
READ(iunout,*)
READ(iunout,*) elist(:)
DO ie=1,ne
IF (abs(elist_(ie) - elist(ie)) .GT. 1.d-10) THEN
IF (abs(elist(ie) - earr(ie)) .GT. 1.d-10) THEN
ierr = ie+1
EXIT
ENDIF
ENDDO
!
CALL iotk_scan_end( iunpun, "SCATTERING_ENERGIES" )
IF (ierr .NE. 0 ) CALL errore('cond_readfile', &
'error while reading energies from info file',ierr)
!
CALL iotk_close_read( iunpun )
READ(iunout,*)
READ(iunout,*) nk
IF ( nk .NE. nkpts ) ierr = 1
!
ENDIF
!
CALL mp_bcast( ierr, ionode_id, intra_image_comm )
!
END SUBROUTINE read_elist
!
!------------------------------------------------------------------------
SUBROUTINE read_klist( dirname, nk, klist, wk, ierr )
!------------------------------------------------------------------------
!
CHARACTER(LEN=*), INTENT(IN) :: dirname
INTEGER, INTENT(IN) :: nk
REAL(DP), INTENT(IN) :: klist(:,:), wk(:)
INTEGER, INTENT(OUT) :: ierr
!
INTEGER :: nk_, ik
REAL(DP) :: kpt_(2), wk_
!
ierr = 0
!
IF ( ionode ) &
CALL iotk_open_read( iunpun, FILE = TRIM( dirname ) // '/' // &
& TRIM( xmlpun ), IERR = ierr )
!
CALL mp_bcast( ierr, ionode_id, intra_image_comm )
!
IF ( ierr .NE. 0 ) RETURN
!
IF ( ionode ) THEN
!
CALL iotk_scan_begin( iunpun, "K-POINTS_MESH" )
!
CALL iotk_scan_dat( iunpun, "NUMBER_OF_K-POINTS", nk_ )
!
IF ( nk_ .NE. nk ) ierr = 1
!
ENDIF
CALL mp_bcast( ierr, ionode_id, intra_image_comm )
!
IF ( ierr .NE. 0 ) RETURN
IF ( ionode ) THEN
DO ik = 1, nk
!
CALL iotk_scan_empty(iunpun, "K-POINT"//TRIM(iotk_index(ik)), attr)
!
CALL iotk_scan_attr( attr, "XY", kpt_ )
IF ( sum(abs(kpt_(:) - klist(:,ik))) .GT. 3.d-10 ) THEN
READ(iunout,*)
READ(iunout,*) kpt(:)
IF ( sum(abs(kpt(:) - xyk(:,ik))) .GT. 3.d-10 ) THEN
ierr = ik+1
EXIT
ENDIF
!
CALL iotk_scan_attr( attr, "WEIGHT", wk_ )
!
IF ( abs(wk_ - wk(ik)) .GT. 1.d-10 ) THEN
READ(iunout,*) wk
IF ( abs(wk - wkpt(ik)) .GT. 1.d-10 ) THEN
ierr = nk+ik+1
EXIT
ENDIF
!
END DO
IF (ierr .NE. 0 ) CALL errore('cond_readfile', &
'error while reading k-points from info file',ierr)
!
CALL iotk_scan_end( iunpun, "K-POINTS_MESH" )
ELSE
!
CALL iotk_close_read( iunpun )
READ(iunout,*)
READ(iunout,*) tcurr
!
ENDIF
END IF
!
CALL mp_bcast( ierr, ionode_id, intra_image_comm )
CLOSE (iunout, STATUS='keep' )
!
END SUBROUTINE read_klist
!
!------------------------------------------------------------------------
SUBROUTINE read_transmission( dirname, ik, ie, t, ierr )
!------------------------------------------------------------------------
RETURN
!
CHARACTER(LEN=*), INTENT(IN) :: dirname
INTEGER, INTENT(IN) :: ie, ik
REAL(DP), INTENT(OUT) :: t
INTEGER, INTENT(OUT) :: ierr
!
CHARACTER(LEN=256) :: filename
CHARACTER(LEN=6), EXTERNAL :: int_to_char
!
ierr = 0
!
IF ( ionode ) THEN
!
filename = TRIM( dirname ) // '/' // tk_file // '_k' // &
TRIM(int_to_char(ik)) // '_e' // TRIM(int_to_char(ie))
CALL iotk_open_read( iunout, FILE = TRIM( filename ), &
BINARY = .FALSE., IERR = ierr )
ENDIF
!
CALL mp_bcast( ierr, ionode_id, intra_image_comm )
!
IF ( ierr .NE. 0 ) THEN
ierr = 1 ! file not found
RETURN
ENDIF
!
IF ( ionode ) THEN
!
CALL iotk_scan_dat( iunout, "PARTIAL_TRANSMISSION", t, IERR = ierr )
!
CALL iotk_close_read( iunout )
!
ENDIF
!
IF ( ierr .NE. 0 ) ierr = 2 ! file not readable?
CALL mp_bcast( ierr, ionode_id, intra_image_comm )
!
END SUBROUTINE read_transmission
!
!
END SUBROUTINE cond_readfile
!
END MODULE cond_restart

1
PWCOND/src/make.depend
View File

@ -22,7 +22,6 @@ cond_restart.o : ../../Modules/mp_images.o
cond_restart.o : ../../Modules/parser.o
cond_restart.o : ../../Modules/version.o
cond_restart.o : ../../UtilXlib/mp.o
cond_restart.o : ../../iotk/src/iotk_module.o
cond_restart.o : condcom.o
condcom.o : ../../Modules/kind.o
condcom.o : ../../Modules/parameters.o