Quantities of a LDA+U calculation are again written on file ".save",

similarly to what was previously done by the "saveall" routine but
according to the new format. Two subroutines have been added to
"io_base" (write_restart_ldaU and read_restart_ldaU) which are called
by "restart".


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@939 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
fabris 2004-06-02 10:29:02 +00:00
parent 1922f218c6
commit 8f8bb37989
2 changed files with 226 additions and 11 deletions

View File

@ -14,6 +14,7 @@
! XDIM ! write_restart_xdim read_restart_xdim !
! CELL ! write_restart_cell read_restart_cell !
! IONS ! write_restart_ions read_restart_ions !
! LDA+U ! write_restart_ldaU read_restart_ldaU
! SYMMETRIES ! write_restart_symmetry read_restart_symmetry !
! do i = 1, ntyp ! !
! PSEUDOPOTENTIALS( i ) ! write_restart_pseudo read_restart_pseudo !
@ -87,6 +88,13 @@
MODULE PROCEDURE read_restart_electrons1, read_restart_electrons2
END INTERFACE
INTERFACE write_restart_ldaU
MODULE PROCEDURE write_restart_ldaU1, write_restart_ldaU2
END INTERFACE
INTERFACE read_restart_ldaU
MODULE PROCEDURE read_restart_ldaU1, read_restart_ldaU2
END INTERFACE
INTERFACE write_restart_symmetry
MODULE PROCEDURE write_restart_symmetry1, write_restart_symmetry2
END INTERFACE
@ -170,6 +178,7 @@
ecutwfc, ecutrho, alat, ekinc, kunit, k1, k2, k3, nk1, nk2, nk3, dgauss, &
ngauss, lgauss, ntetra, ltetra, natomwfc, gcutm, gcuts, dual, doublegrid, &
modenum, lforce, lstres, title, crystal, tmp_dir, tupf, gamma_only, &
lda_plus_u, &
tfixed_occ, tefield, dipfield, edir, emaxpos, eopreg, eamp, twfcollect )
!
USE io_global, ONLY: ionode
@ -217,6 +226,7 @@
! gamma_only is .TRUE. if calculation is at gamma (G-vecs span only half space)
LOGICAL, INTENT(IN) :: gamma_only
LOGICAL, INTENT(IN) :: lda_plus_u
LOGICAL, INTENT(IN) :: tfixed_occ
LOGICAL, INTENT(IN) :: tefield
@ -249,7 +259,8 @@
WRITE(iuni) nfi, iswitch, nr1, nr2, nr3, nr1s, nr2s, nr3s, ng_g, nk_g, &
nspin, nbnd, nel, nelu, neld, nat, ntyp, nacc, trutim, ecutwfc, ecutrho, alat, ekinc, &
kunit, k1, k2, k3, nk1, nk2, nk3, dgauss, ngauss, lgauss, ntetra, ltetra, &
natomwfc, gcutm, gcuts, dual, doublegrid, modenum, lstres, lforce, tupf, gamma_only, &
natomwfc, gcutm, gcuts, dual, doublegrid, modenum, lstres, lforce, tupf, &
gamma_only, lda_plus_u, &
tfixed_occ, tefield, dipfield, edir, emaxpos, eopreg, eamp, twfcollect
WRITE(iuni) (na(i),i=1,ntyp), (ngwk_g(i),i=1,nk_g), (acc(i),i=1,nacc)
WRITE(iuni) t_, c_, tmp_dir_
@ -291,7 +302,7 @@
nat, ntyp, na, acc, nacc, ecutwfc, ecutrho, alat, ekinc, kunit, &
k1, k2, k3, nk1, nk2, nk3, dgauss, ngauss, lgauss, ntetra, ltetra, &
natomwfc, gcutm, gcuts, dual, doublegrid, modenum, &
lforce, lstres, title, crystal, tmp_dir, tupf, gamma_only, &
lforce, lstres, title, crystal, tmp_dir, tupf, gamma_only, lda_plus_u,&
tfixed_occ, tefield, dipfield, edir, emaxpos, eopreg, eamp, twfcollect )
!
@ -335,6 +346,7 @@
CHARACTER(LEN=*), INTENT(OUT) :: tmp_dir
LOGICAL, INTENT(OUT) :: tupf
LOGICAL, INTENT(OUT) :: gamma_only
LOGICAL, INTENT(OUT) :: lda_plus_u
LOGICAL, INTENT(OUT) :: tfixed_occ
LOGICAL, INTENT(OUT) :: tefield
@ -366,7 +378,7 @@
nspin, nbnd, nel, nelu, neld, nat, ntyp, nacc, trutim, ecutwfc, ecutrho, &
alat, ekinc, kunit, k1, k2, k3, nk1, nk2, nk3, dgauss, ngauss, lgauss, &
ntetra, ltetra, natomwfc, gcutm, gcuts, dual, doublegrid, modenum, lstres, &
lforce, tupf, gamma_only, &
lforce, tupf, gamma_only, lda_plus_u,&
tfixed_occ, tefield, dipfield, edir, emaxpos, eopreg, eamp, twfcollect
END IF
!
@ -415,6 +427,7 @@
CALL mp_bcast( lforce, ionode_id )
CALL mp_bcast( tupf, ionode_id )
CALL mp_bcast( gamma_only, ionode_id )
CALL mp_bcast( lda_plus_u, ionode_id )
CALL mp_bcast( tfixed_occ, ionode_id )
CALL mp_bcast( tefield, ionode_id )
@ -626,6 +639,167 @@
END SUBROUTINE
!=----------------------------------------------------------------------------=!
!
!
!
!=----------------------------------------------------------------------------=!
! .. This subroutine write to disk variable related to the lda+U calculation
! .. Where:
! iuni = Restart file I/O fortran unit
!
SUBROUTINE write_restart_ldaU1(iuni, &
ntyp, Hubbard_lmax, Hubbard_l, Hubbard_U, Hubbard_alpha)
!
USE io_global, ONLY: ionode
!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: iuni
INTEGER, INTENT(IN) :: ntyp
INTEGER, INTENT(IN) :: Hubbard_lmax
INTEGER, INTENT(IN) :: Hubbard_l(:)
REAL(dbl), INTENT(IN) :: Hubbard_U(:)
REAL(dbl), INTENT(IN) :: Hubbard_alpha(:)
INTEGER :: i
CHARACTER(LEN=30) :: sub_name = ' write_restart_ldaU '
CHARACTER(LEN=20) :: section_name = 'ldaU'
LOGICAL :: twrite = .TRUE.
IF( ionode ) THEN
WRITE(iuni) twrite, file_version, section_name
WRITE(iuni) ntyp
WRITE(iuni) Hubbard_lmax
WRITE(iuni) (Hubbard_l(i),i=1,ntyp)
WRITE(iuni) (Hubbard_U(i),i=1,ntyp)
WRITE(iuni) (Hubbard_alpha(i),i=1,ntyp)
ENDIF
RETURN
END SUBROUTINE
!=----------------------------------------------------------------------------=!
!
!
!
!=----------------------------------------------------------------------------=!
SUBROUTINE write_restart_ldaU2(iuni)
USE io_global, ONLY: ionode, ionode_id
USE mp_global, ONLY: group
USE mp, ONLY: mp_bcast
IMPLICIT NONE
INTEGER, INTENT(IN) :: iuni
LOGICAL :: twrite = .FALSE.
INTEGER :: idum = 0
CHARACTER(LEN=20) :: section_name = 'ldaU'
IF( ionode ) THEN
WRITE(iuni) twrite, file_version, section_name
WRITE(iuni) idum
WRITE(iuni) idum
WRITE(iuni) idum
WRITE(iuni) idum
WRITE(iuni) idum
END IF
RETURN
END SUBROUTINE
!=----------------------------------------------------------------------------=!
!
!
!
!=----------------------------------------------------------------------------=!
SUBROUTINE read_restart_ldaU1(iuni, &
ntyp, Hubbard_lmax, Hubbard_l, Hubbard_U, Hubbard_alpha)
!
USE io_global, ONLY: ionode, ionode_id
USE mp_global, ONLY: group
USE mp, ONLY: mp_bcast
!
IMPLICIT NONE
INTEGER, INTENT(IN) :: iuni
INTEGER, INTENT(OUT) :: ntyp
INTEGER, INTENT(OUT) :: Hubbard_lmax
INTEGER, INTENT(OUT) :: Hubbard_l(:)
REAL(dbl), INTENT(OUT) :: Hubbard_U(:)
REAL(dbl), INTENT(OUT) :: Hubbard_alpha(:)
INTEGER :: i
LOGICAL :: twrite_
INTEGER :: ierr
INTEGER :: idum
CHARACTER(LEN=30) :: sub_name = ' read_restart_ldaU '
CHARACTER(LEN=20) :: section_name = 'ldaU'
CHARACTER(LEN=20) :: section_name_
!
! ... Subroutine Body
!
CALL data_section_head( iuni, section_name_ , twrite_ , ierr )
IF( .NOT. twrite_ ) &
CALL errore(' read_restart_ldaU ',' Data Section not present in restart file ', 1)
! aggiungere qualche check
!
IF( ionode ) THEN
READ(iuni) ntyp
END IF
CALL mp_bcast(ntyp, ionode_id)
IF( ionode ) THEN
READ(iuni) Hubbard_lmax
READ(iuni) (Hubbard_l(i),i=1,ntyp)
READ(iuni) (Hubbard_U(i),i=1,ntyp)
READ(iuni) (Hubbard_alpha(i),i=1,ntyp)
ENDIF
CALL mp_bcast(Hubbard_lmax, ionode_id)
CALL mp_bcast(Hubbard_l, ionode_id)
CALL mp_bcast(Hubbard_U, ionode_id)
CALL mp_bcast(Hubbard_alpha, ionode_id)
RETURN
END SUBROUTINE
!=----------------------------------------------------------------------------=!
!
!
!
!=----------------------------------------------------------------------------=!
SUBROUTINE read_restart_ldaU2(iuni)
USE io_global, ONLY: ionode, ionode_id
USE mp_global, ONLY: group
USE mp, ONLY: mp_bcast
IMPLICIT NONE
INTEGER, INTENT(IN) :: iuni
LOGICAL :: twrite_
INTEGER :: ierr
INTEGER :: idum
CHARACTER(LEN=20) :: section_name = 'ldaU'
CHARACTER(LEN=20) :: section_name_
CALL data_section_head( iuni, section_name_ , twrite_ , ierr )
IF( ionode ) THEN
READ(iuni) idum
READ(iuni) idum
READ(iuni) idum
READ(iuni) idum
READ(iuni) idum
END IF
IF( restart_module_verbosity > 1000 ) &
WRITE( stdout,fmt="(3X,'W: read_restart_ldaU, Data Section not read from restart ' )")
RETURN
END SUBROUTINE
!=----------------------------------------------------------------------------=!
!
!

View File

@ -66,11 +66,13 @@ subroutine writefile_new( what, ndw, et_g, wg_g, kunit )
write_restart_cell, write_restart_electrons, &
write_restart_gvec, write_restart_gkvec, write_restart_charge, &
write_restart_wfc, write_restart_symmetry, &
write_restart_xdim, write_restart_pseudo
write_restart_xdim, write_restart_pseudo, write_restart_ldaU
USE parameters, only: nacx, nsx, npk
use read_pseudo_module
use pseudo_types
USE ldaU, ONLY: lda_plus_u, Hubbard_lmax, Hubbard_l, &
Hubbard_U, Hubbard_alpha
implicit none
!
@ -237,8 +239,9 @@ subroutine writefile_new( what, ndw, et_g, wg_g, kunit )
nat, ntyp, na, acc, nacx, ecutwfc, ecutrho, alat, ekincm, &
kunit, k1, k2, k3, nk1, nk2, nk3, degauss, ngauss, lgauss, ntetra, ltetra, &
natomwfc, gcutm, gcutms, dual, doublegrid, modenum, lstres, lforce, &
title, crystal, tmp_dir, tupf, lgamma, &
title, crystal, tmp_dir, tupf, lgamma, lda_plus_u, &
tfixed_occ, tefield, dipfield, edir, emaxpos, eopreg, eamp, twfcollect)
else
CALL write_restart_header(ndw)
end if
@ -308,6 +311,16 @@ subroutine writefile_new( what, ndw, et_g, wg_g, kunit )
DEALLOCATE( stau0, svel0, staum, svelm, tautmp )
! ==--------------------------------------------------------------==
! == LDA+U ==
! ==--------------------------------------------------------------==
if (lda_plus_u) then
CALL write_restart_ldaU(ndw, ntyp, Hubbard_lmax, &
Hubbard_l(1:ntyp), Hubbard_U(1:ntyp), Hubbard_alpha(1:ntyp))
else
CALL write_restart_ldaU(ndw)
endif
! ==--------------------------------------------------------------==
! == SYMMETRIES ==
! ==--------------------------------------------------------------==
@ -536,10 +549,12 @@ subroutine readfile_new( what, ndr, et_g, wg_g, kunit, nsizwfc, iunitwfc, ierr )
read_restart_cell, read_restart_electrons, &
read_restart_gvec, read_restart_gkvec, read_restart_charge, &
read_restart_wfc, read_restart_symmetry, &
read_restart_xdim, read_restart_pseudo
read_restart_xdim, read_restart_pseudo, read_restart_ldaU
USE parameters, only: nacx, nsx
use upf_to_internal
USE ldaU, ONLY: lda_plus_u, Hubbard_lmax, Hubbard_l, &
Hubbard_U, Hubbard_alpha
implicit none
!
@ -670,7 +685,7 @@ subroutine readfile_new( what, ndr, et_g, wg_g, kunit, nsizwfc, iunitwfc, ierr )
neld_, nat, ntyp, na_, acc_, nacx_, ecutwfc, ecutrho_, alat, ekincm_, &
kunit_, k1, k2, k3, nk1, nk2, nk3, degauss, ngauss, lgauss, ntetra, ltetra, &
natomwfc, gcutm, gcutms, dual, doublegrid, modenum, lstres, lforce, &
title_, crystal_, tmp_dir_, tupf, lgamma, &
title_, crystal_, tmp_dir_, tupf, lgamma, lda_plus_u,&
tfixed_occ, tefield, dipfield, edir, emaxpos, eopreg, eamp, twfcollect )
gamma_only = lgamma
@ -715,7 +730,8 @@ subroutine readfile_new( what, ndr, et_g, wg_g, kunit, nsizwfc, iunitwfc, ierr )
nks = nkl
ELSE
ELSE
CALL read_restart_header(ndr)
@ -795,6 +811,20 @@ subroutine readfile_new( what, ndr, et_g, wg_g, kunit, nsizwfc, iunitwfc, ierr )
END IF
! ==--------------------------------------------------------------==
! == LDA+U ==
! ==--------------------------------------------------------------==
IF( lda_plus_u) THEN
CALL read_restart_ldaU(ndr, ntyp, Hubbard_lmax, &
Hubbard_l(1:ntyp), Hubbard_U(1:ntyp), Hubbard_alpha(1:ntyp))
ELSE
CALL read_restart_ldaU(ndr)
ENDIF
! ==--------------------------------------------------------------==
! == SYMMETRIES ==
! ==--------------------------------------------------------------==
@ -1050,12 +1080,14 @@ subroutine readfile_config( ndr, ibrav, nat, alat, at, tau, ierr )
use io_global, only: ionode, ionode_id
USE mp_global, ONLY : intra_image_comm
use mp, only: mp_bcast
USE ldaU, ONLY: lda_plus_u, Hubbard_lmax, Hubbard_l, &
Hubbard_U, Hubbard_alpha
USE io_base, only: read_restart_header, read_restart_ions, &
read_restart_cell, read_restart_electrons, &
read_restart_gvec, read_restart_gkvec, read_restart_charge, &
read_restart_wfc, read_restart_symmetry, &
read_restart_xdim, read_restart_pseudo
read_restart_xdim, read_restart_pseudo, read_restart_ldaU
implicit none
!
@ -1079,11 +1111,12 @@ subroutine readfile_config( ndr, ibrav, nat, alat, at, tau, ierr )
integer :: k1_, k2_, k3_, nk1_, nk2_, nk3_, ngauss_
integer :: na_(nsx), ngk_l(npk), ngk_g(npk)
integer :: ntetra_, natomwfc_, modenum_
integer :: Hubbard_lmax_
integer :: npwx_, nbndx_, nrx1_, nrx2_, nrx3_, nrxx_, nrx1s_, nrx2s_, nrx3s_, nrxxs_
real(kind=DP) :: trutime_, nelec_, ecutwfc_, ecutrho_, alat_, ekincm_
real(kind=DP) :: degauss_, gcutm_, gcutms_, dual_
real(kind=DP) :: acc_(nacx)
logical :: lgauss_, ltetra_, doublegrid_, lstres_, lforce_, tupf_, lgamma_
logical :: lgauss_, ltetra_, doublegrid_, lstres_, lforce_, tupf_, lgamma_, lda_plus_u_
character(len=80) :: title_, crystal_, tmp_dir_
real(kind=DP) :: celldm_(6)
@ -1130,7 +1163,7 @@ subroutine readfile_config( ndr, ibrav, nat, alat, at, tau, ierr )
neld_, nat_, ntyp_, na_, acc_, nacx_, ecutwfc_, ecutrho_, alat_, ekincm_, &
kunit_, k1_, k2_, k3_, nk1_, nk2_, nk3_, degauss_, ngauss_, lgauss_, ntetra_, ltetra_, &
natomwfc_, gcutm_, gcutms_, dual_, doublegrid_, modenum_, lstres_, lforce_, &
title_, crystal_, tmp_dir_, tupf_, lgamma_, &
title_, crystal_, tmp_dir_, tupf_, lgamma_, lda_plus_u_, &
tfixed_occ_, tefield_, dipfield_, edir_, emaxpos_, eopreg_, eamp_, twfcollect_ )
! ==--------------------------------------------------------------==
@ -1179,6 +1212,14 @@ subroutine readfile_config( ndr, ibrav, nat, alat, at, tau, ierr )
DEALLOCATE( stau0, svel0, staum, svelm, tautmp, ityp_, force_, amass_ )
! ==--------------------------------------------------------------==
! == LDA+U ==
! ==--------------------------------------------------------------==
IF( lda_plus_u) THEN
CALL read_restart_ldaU(ndr, ntyp_, Hubbard_lmax_, &
Hubbard_l(1:ntyp_), Hubbard_U(1:ntyp_), Hubbard_alpha(1:ntyp_))
ENDIF
!
if( ionode ) then
close (unit = ndr)