mirror of https://gitlab.com/QEF/q-e.git
248 lines
7.5 KiB
Fortran
248 lines
7.5 KiB
Fortran
!
|
|
! Copyright (C) 2001-2003 PWSCF 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 "machine.h"
|
|
!
|
|
!-----------------------------------------------------------------------
|
|
SUBROUTINE bfgs()
|
|
!-----------------------------------------------------------------------
|
|
!
|
|
! ... ionic relaxation through broyden-fletcher-goldfarb-shanno
|
|
! ... minimization
|
|
! ... this version saves data at each iteration
|
|
!
|
|
USE kinds, ONLY : DP
|
|
USE cell_base, ONLY : alat
|
|
USE basis, ONLY : nat, tau
|
|
USE force_mod, ONLY : force
|
|
USE control_flags, ONLY : conv_ions, upscale, imix, tr2, ethr, istep
|
|
USE relax, ONLY : restart_bfgs, epse, epsf, starting_diag_threshold, &
|
|
starting_scf_threshold, dtau_ref
|
|
USE ener, ONLY : etot
|
|
USE klist, ONLY : nelec
|
|
USE io_global, ONLY : stdout
|
|
USE io_files, ONLY : prefix
|
|
!
|
|
IMPLICIT NONE
|
|
!
|
|
INTEGER :: iunit ! unit for file containing bfgs info
|
|
INTEGER :: nax3, & ! 3 times the total number of atoms (nat)
|
|
na, i ! counters
|
|
REAL(KIND=DP), ALLOCATABLE :: &
|
|
hessm1 (:,:),& ! current estimate of hessian^-1
|
|
dtau (:,:), & ! direction (versor) for line minimization
|
|
oldforce (:,:) ! gradient along minimization direction
|
|
REAL(KIND=DP) :: &
|
|
detot, & ! forces at previous line minimum (LM)
|
|
deold, & ! as above at previous LM
|
|
eold, & ! energy at previous LM
|
|
xold, & ! position along dtau at previous LM
|
|
x, & ! present position along dtau
|
|
xnew ! next position along dtau
|
|
|
|
LOGICAL :: exst, & ! test variable on existence of bfgs file
|
|
minimum_ok ! true if linmin found a good line minimum
|
|
!
|
|
REAL(KIND=DP) :: DDOT
|
|
!
|
|
!
|
|
! ... the constrain on fixed coordinates is implemented setting to zero
|
|
! ... the forces in forces.f90 ( C.S. 15/10/2003 )
|
|
!
|
|
nax3 = 3 * nat
|
|
conv_ions = .FALSE.
|
|
!
|
|
ALLOCATE( hessm1(nax3,nax3), dtau(3,nat), oldforce(3,nat) )
|
|
!
|
|
iunit = 4
|
|
!
|
|
CALL seqopn( iunit, TRIM( prefix )//'.bfgs', 'UNFORMATTED', exst )
|
|
!
|
|
! ... exst flags whether restarting from preceding iterations
|
|
! ... do not restart from existing data unless explicitely required
|
|
!
|
|
exst = ( exst .AND. restart_bfgs )
|
|
!
|
|
IF ( .NOT. exst ) THEN
|
|
!
|
|
! ... file not found: starting iteration
|
|
!
|
|
CLOSE( UNIT = iunit, STATUS = 'DELETE' )
|
|
minimum_ok = .FALSE.
|
|
!
|
|
CALL estimate( hessm1, nax3, nat, nax3 )
|
|
!
|
|
WRITE( stdout, '(/5X,"EPSE = ",E9.2," EPSF = ",E9.2, &
|
|
& " UPSCALE = ",F6.2)') epse, epsf, upscale
|
|
!
|
|
ELSE
|
|
!
|
|
! ... file found: restart from preceding iterations
|
|
!
|
|
READ( iunit ) &
|
|
minimum_ok, xnew, starting_scf_threshold, starting_diag_threshold
|
|
READ( iunit ) dtau
|
|
READ( iunit ) hessm1
|
|
READ( iunit ) xold, eold, deold, oldforce
|
|
!
|
|
CLOSE( UNIT = iunit, STATUS = 'KEEP' )
|
|
!
|
|
END IF
|
|
!
|
|
20 CONTINUE
|
|
!
|
|
IF ( exst .AND. .NOT. minimum_ok ) THEN
|
|
!
|
|
! ... Search for a new line minimum
|
|
!
|
|
x = xnew
|
|
detot = - DDOT( nax3, force, 1, dtau, 1 )
|
|
!
|
|
! ... line minimization with 3rd order interpolation formula
|
|
!
|
|
CALL linmin( xold, eold, deold, x, etot, detot, xnew, minimum_ok )
|
|
!
|
|
! ... xnew close to x: line minimization already achieved
|
|
!
|
|
IF ( ABS( ( xnew - x ) / x ) < 0.05D0 .AND. minimum_ok ) GOTO 20
|
|
!
|
|
! ... new positions ( hopefully close to the line minimum ) :
|
|
!
|
|
CALL DAXPY( nax3, ( xnew - x ) / alat, dtau, 1, tau, 1 )
|
|
!
|
|
IF ( .NOT. minimum_ok ) THEN
|
|
!
|
|
! ... line minimum was not found take another step and reset the
|
|
! ... starting point of the line minimization to the present position
|
|
!
|
|
xold = x
|
|
eold = etot
|
|
deold = detot
|
|
!
|
|
CALL DCOPY( nax3, force, 1, oldforce, 1 )
|
|
!
|
|
END IF
|
|
!
|
|
ELSE
|
|
!
|
|
IF ( exst ) THEN
|
|
!
|
|
! ... We (hopefully) are at the line minimum: convergence check
|
|
!
|
|
conv_ions = ( ( eold - etot ) < epse )
|
|
!
|
|
DO i = 1, 3
|
|
DO na = 1, nat
|
|
conv_ions = ( conv_ions .AND. ( ABS( force(i,na) ) < epsf ) )
|
|
END DO
|
|
END DO
|
|
!
|
|
! ... update the inverse hessian
|
|
! ... set dtau to the true displacements from previous to present LM
|
|
!
|
|
CALL DSCAL( nax3, ( xnew - xold ), dtau, 1 )
|
|
CALL updathes( nax3, nax3, oldforce, force, hessm1, dtau )
|
|
!
|
|
END IF
|
|
!
|
|
! ... find new minimization direction dtau
|
|
!
|
|
x = 0.D0
|
|
minimum_ok = .FALSE.
|
|
dtau(:,:) = 0.D0
|
|
!
|
|
CALL DGEMV( 'N', nax3, nax3, 1.D0, hessm1, nax3, force, 1, &
|
|
0.D0, dtau, 1 )
|
|
xnew = SQRT( DDOT( nax3, dtau, 1, dtau, 1 ) )
|
|
CALL DSCAL( nax3, 1.D0 / xnew, dtau, 1 )
|
|
!
|
|
! ... and the gradient along the minimization direction dtau
|
|
!
|
|
detot = - DDOT( nax3, force, 1, dtau, 1 )
|
|
!
|
|
IF ( detot > 0.D0 ) THEN
|
|
!
|
|
WRITE( stdout, '("uphill direction! de/dx =",E10.4)') detot
|
|
WRITE( stdout, '("try steepest descent direction instead!")')
|
|
!
|
|
CALL DCOPY( nax3, force, 1, dtau, 1 )
|
|
xnew = SQRT( DDOT( nax3, dtau, 1, dtau, 1 ) )
|
|
CALL DSCAL( nax3, 1.D0 / xnew, dtau, 1 )
|
|
detot = - DDOT( nax3, force, 1, dtau, 1 )
|
|
!
|
|
END IF
|
|
!
|
|
! ... update atomic positions. NB: tau in units of alat!
|
|
!
|
|
CALL DAXPY( nax3, ( xnew - x ) / alat, dtau, 1, tau, 1 )
|
|
!
|
|
! ... save values of variables at line minimum for later use
|
|
!
|
|
xold = x
|
|
eold = etot
|
|
deold = detot
|
|
!
|
|
CALL DCOPY( nax3, force, 1, oldforce, 1 )
|
|
!
|
|
END IF
|
|
!
|
|
! ... set appropriate (?) thresholds for self-consistency
|
|
!
|
|
! ... ethr is now updated in electrons with a different procedure
|
|
! ... this value of ethr is overwritten apart when the old style
|
|
! ... update is used (see OLDSTYLE precompiler variable in electrons)
|
|
!
|
|
IF ( imix < 0 ) THEN
|
|
tr2 = ( starting_scf_threshold * MAX( 1.D0 / upscale, MIN( 1.D0, &
|
|
ABS( xnew - x ) / dtau_ref ) ) )**2
|
|
ethr = starting_diag_threshold * MAX( 1.D0 / upscale, MIN( 1.D0, &
|
|
ABS( xnew - x ) / dtau_ref ) )**2
|
|
ELSE
|
|
ethr = tr2 / nelec
|
|
tr2 = starting_scf_threshold * &
|
|
MAX( 1.D0/upscale, ABS( xnew - x ) / dtau_ref )
|
|
END IF
|
|
!
|
|
! ... report
|
|
!
|
|
IF ( conv_ions ) THEN
|
|
WRITE( stdout, '(/5X,"BFGS: convergence achieved, Efinal=",F15.8)') etot
|
|
WRITE( stdout, '(/72("-")//5X,"Final estimate of positions")')
|
|
ELSE
|
|
WRITE( stdout, '(/72("-")//5X, &
|
|
&"Search of equilibrium positions: iteration # ",I4, &
|
|
&", scf threshold ",1PE8.2/)') istep, tr2
|
|
END IF
|
|
!
|
|
CALL output_tau (conv_ions)
|
|
!
|
|
! ... save all quantities needed at the following iterations
|
|
!
|
|
IF ( .NOT. conv_ions ) THEN
|
|
!
|
|
CALL seqopn( iunit, TRIM( prefix )//'.bfgs', 'UNFORMATTED', exst )
|
|
WRITE( iunit ) &
|
|
minimum_ok, xnew, starting_scf_threshold, starting_diag_threshold
|
|
WRITE( iunit ) dtau
|
|
WRITE( iunit ) hessm1
|
|
WRITE( iunit ) xold, eold, deold, oldforce
|
|
CLOSE( UNIT = iunit, STATUS = 'KEEP' )
|
|
!
|
|
! ... at next iteration read from file
|
|
!
|
|
restart_bfgs = .TRUE.
|
|
!
|
|
END IF
|
|
!
|
|
DEALLOCATE( hessm1, dtau, oldforce )
|
|
!
|
|
!
|
|
RETURN
|
|
!
|
|
END SUBROUTINE bfgs
|
|
|