mirror of https://gitlab.com/QEF/q-e.git
463 lines
14 KiB
Fortran
463 lines
14 KiB
Fortran
!
|
|
! Copyright (C) 2008 Quantum-ESPRESSO group
|
|
! This file is distributed under the terms of the
|
|
! GNU General Public License. See the file `License'
|
|
! in the root directory of the present distribution,
|
|
! or http://www.gnu.org/copyleft/gpl.txt .
|
|
!
|
|
#include "f_defs.h"
|
|
!
|
|
!----------------------------------------------------------------------------
|
|
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 xml_io_base, ONLY : create_directory, write_header, attr
|
|
USE io_files, ONLY : tmp_dir, tran_prefix, tk_file, xmlpun, iunpun, &
|
|
qexml_version, qexml_version_init
|
|
USE io_global, ONLY : ionode, ionode_id
|
|
USE mp_global, ONLY : intra_image_comm
|
|
USE mp, ONLY : mp_bcast
|
|
!
|
|
IMPLICIT NONE
|
|
!
|
|
SAVE
|
|
!
|
|
PRIVATE
|
|
!
|
|
PUBLIC :: cond_writefile, cond_readfile
|
|
!
|
|
INTEGER, PRIVATE :: iunout
|
|
!
|
|
! variables to describe qexml current version
|
|
! and back compatibility
|
|
!
|
|
LOGICAL :: qexml_version_before_1_4_0 = .FALSE.
|
|
!
|
|
!
|
|
CONTAINS
|
|
!
|
|
!------------------------------------------------------------------------
|
|
SUBROUTINE cond_writefile( what, kcurr, ecurr, tcurr )
|
|
!------------------------------------------------------------------------
|
|
!
|
|
USE global_version, ONLY : version_number
|
|
USE cond, ONLY : nenergy, earr, nkpts, xyk, wkpt
|
|
!
|
|
IMPLICIT NONE
|
|
!
|
|
CHARACTER(LEN=*), INTENT(IN) :: what
|
|
INTEGER, INTENT(IN), OPTIONAL :: ecurr, kcurr
|
|
REAL(DP), INTENT(IN), OPTIONAL :: tcurr
|
|
!
|
|
CHARACTER(LEN=256) :: dirname, filename
|
|
INTEGER :: ierr
|
|
CHARACTER(LEN=6), EXTERNAL :: int_to_char
|
|
|
|
|
|
! 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)
|
|
!
|
|
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)
|
|
!
|
|
! 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)
|
|
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)
|
|
ELSE
|
|
CALL errore('cond_writefile','unknown what',1)
|
|
ENDIF
|
|
!
|
|
END IF
|
|
!
|
|
CALL mp_bcast(ierr, ionode_id, intra_image_comm)
|
|
!
|
|
CALL errore('cond_writefile ', &
|
|
'cannot open xml_recover file for writing', ierr )
|
|
!
|
|
IF ( ionode ) THEN
|
|
!
|
|
! here we start writing the cond-punch-file
|
|
IF ( what=='init' ) THEN
|
|
!
|
|
CALL write_header("PWCOND", TRIM(version_number))
|
|
!
|
|
CALL write_elist(nenergy, earr)
|
|
!
|
|
CALL write_klist(nkpts, xyk, wkpt)
|
|
!
|
|
CALL iotk_close_write(iunpun)
|
|
!
|
|
ELSEIF ( what=='tran' ) THEN
|
|
!
|
|
CALL write_transmission(ecurr, kcurr, tcurr)
|
|
!
|
|
CALL iotk_close_write(iunout)
|
|
!
|
|
ENDIF
|
|
!
|
|
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 )
|
|
!------------------------------------------------------------------------
|
|
!
|
|
USE cond, ONLY : nenergy, earr, nkpts, xyk, wkpt
|
|
IMPLICIT NONE
|
|
!
|
|
CHARACTER(LEN=*), INTENT(IN) :: what
|
|
INTEGER, INTENT(IN), OPTIONAL :: ecurr, kcurr
|
|
REAL(DP), INTENT(OUT), OPTIONAL :: tcurr
|
|
INTEGER, INTENT(OUT) :: ierr
|
|
!
|
|
CHARACTER(LEN=256) :: dirname
|
|
!
|
|
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 )
|
|
!
|
|
CALL mp_bcast( ierr,ionode_id,intra_image_comm )
|
|
!
|
|
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
|
|
USE xml_io_base
|
|
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 )
|
|
!
|
|
ENDIF
|
|
!
|
|
CALL mp_bcast( qexml_version, ionode_id, intra_image_comm )
|
|
CALL mp_bcast( qexml_version_init, ionode_id, intra_image_comm )
|
|
|
|
!
|
|
! 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
|
|
!
|
|
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_ )
|
|
DO ie=1,ne
|
|
IF (abs(elist_(ie) - elist(ie)) .GT. 1.d-10) THEN
|
|
ierr = ie+1
|
|
EXIT
|
|
ENDIF
|
|
ENDDO
|
|
!
|
|
CALL iotk_scan_end( iunpun, "SCATTERING_ENERGIES" )
|
|
!
|
|
CALL iotk_close_read( iunpun )
|
|
!
|
|
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
|
|
ierr = ik+1
|
|
EXIT
|
|
ENDIF
|
|
!
|
|
CALL iotk_scan_attr( attr, "WEIGHT", wk_ )
|
|
!
|
|
IF ( abs(wk_ - wk(ik)) .GT. 1.d-10 ) THEN
|
|
ierr = nk+ik+1
|
|
EXIT
|
|
ENDIF
|
|
!
|
|
END DO
|
|
!
|
|
CALL iotk_scan_end( iunpun, "K-POINTS_MESH" )
|
|
!
|
|
CALL iotk_close_read( iunpun )
|
|
!
|
|
ENDIF
|
|
!
|
|
CALL mp_bcast( ierr, ionode_id, intra_image_comm )
|
|
!
|
|
END SUBROUTINE read_klist
|
|
!
|
|
!------------------------------------------------------------------------
|
|
SUBROUTINE read_transmission( dirname, ik, ie, t, ierr )
|
|
!------------------------------------------------------------------------
|
|
!
|
|
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 MODULE cond_restart
|