! ! Copyright (C) 2001-2004 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 . ! !---------------------------------------------------------------------------- SUBROUTINE move_ions() !---------------------------------------------------------------------------- ! ! ... This routine moves the ions according to the requested scheme: ! ! ... iswitch = 1 bfgs minimizations ! ... iswitch = 2 constrained bfgs minimization: ! ... the user must supply the routine 'constrain' which ! ... defines the constraint equation and the gradient ! ... the constraint function gv(tau), dgv(i,tau) such ! ... that: ! ! ... gv({tau}) - target = 0, ! ! ... and ! ! ... D gv( {tau} ) ! ... dgv(i,na) = ---------------. ! ... D tau(i,na) ! ! ... iswitch = 3 molecular dynamics, ( verlet of vcsmd ) ! ... iswitch = 4 molecular dynamics with one constraint, ! ... the same conventions as iswitch = 2 ! ! ... coefficients for potential and wavefunctions extrapolation are ! ... also computed here ! USE constants, ONLY : eps8 USE io_global, ONLY : stdout USE io_files, ONLY : tmp_dir, prefix, iunupdate USE kinds, ONLY : DP USE cell_base, ONLY : alat, at, bg USE ions_base, ONLY : nat, ityp, tau, atm USE gvect, ONLY : nr1, nr2, nr3 USE klist, ONLY : nelec USE symme, ONLY : s, ftau, nsym, irt USE ener, ONLY : etot USE force_mod, ONLY : force USE bfgs_module, ONLY : lbfgs_ndim USE control_flags, ONLY : upscale, lbfgs, loldbfgs, lconstrain, & lmd, conv_ions, history, alpha0, beta0, tr2 USE relax, ONLY : epse, epsf, starting_scf_threshold USE lsda_mod, ONLY : lsda, absmag USE cellmd, ONLY : lmovecell, calc USE mp_global, ONLY : intra_image_comm USE io_global, ONLY : ionode_id, ionode USE mp, ONLY : mp_bcast ! ! ... external procedures ! USE bfgs_module, ONLY : new_bfgs => bfgs, lin_bfgs, terminate_bfgs USE constraints_module, ONLY : dist_constrain, check_constrain, & new_force, compute_penalty USE basic_algebra_routines, ONLY : norm ! IMPLICIT NONE ! ! ... local variables ! LOGICAL, SAVE :: lcheck_mag ! .TRUE. if the check of zero absolute magnetization is required REAL(KIND=DP), ALLOCATABLE :: tauold(:,:,:) ! previous positions of atoms REAL(KIND=DP), SAVE :: lambda = 0.5D0 INTEGER :: na REAL(KIND=DP) :: energy_error, gradient_error LOGICAL :: step_accepted, exst REAL(KIND=DP), ALLOCATABLE :: pos(:), gradient(:) ! ! ! ... only one node does the calculation in the parallel case ! IF ( ionode ) THEN ! conv_ions = .FALSE. ! ALLOCATE( tauold( 3, nat, 3 ) ) ! ! ... constrains are imposed here ! IF ( lconstrain ) CALL impose_constrains() ! ! ... the file containing old positions is opened ! ... ( needed for extrapolation ) ! CALL seqopn( iunupdate, TRIM( prefix ) // '.update', 'FORMATTED', exst ) ! IF ( exst ) THEN ! READ( UNIT = iunupdate, FMT = * ) history READ( UNIT = iunupdate, FMT = * ) tauold ! ELSE ! history = 0 tauold = 0.D0 ! WRITE( UNIT = iunupdate, FMT = * ) history WRITE( UNIT = iunupdate, FMT = * ) tauold ! END IF ! CLOSE( UNIT = iunupdate, STATUS = 'KEEP' ) ! ! ... save the previous two steps ( a total of three steps is saved ) ! tauold(:,:,3) = tauold(:,:,2) tauold(:,:,2) = tauold(:,:,1) tauold(:,:,1) = tau(:,:) ! ! ... do the minimization / dynamics step ! IF ( lmovecell .AND. lconstrain ) & CALL errore( 'move_ions', & & 'variable cell and constrain not implemented', 1 ) ! ! ... BFGS algorithm is used to minimize ionic configuration ! IF ( lbfgs ) THEN ! ! ... the new bfgs procedure is used ! ALLOCATE( pos( 3 * nat ) ) ALLOCATE( gradient( 3 * nat ) ) ! pos = RESHAPE( SOURCE = tau, SHAPE = (/ 3 * nat /) ) * alat gradient = - RESHAPE( SOURCE = force, SHAPE = (/ 3 * nat /) ) ! IF ( lbfgs_ndim == 1 ) THEN ! ! ... standard BFGS ! CALL new_bfgs( pos, etot, gradient, tmp_dir, stdout, epse, & epsf, energy_error, gradient_error, step_accepted, & conv_ions ) ! ELSE ! ! ... linear scaling BFGS ! CALL lin_bfgs( pos, etot, gradient, tmp_dir, stdout, epse, & epsf, energy_error, gradient_error, step_accepted, & conv_ions ) ! END IF ! IF ( conv_ions ) THEN ! IF ( ( lsda .AND. ( absmag < eps8 ) .AND. lcheck_mag ) ) THEN ! ! ... lsda relaxation : a final configuration with zero ! ... absolute magnetization has been found ! ! ... here we check if it is really the minimum energy structure ! ... by performing a new scf iteration without any "electronic" ! ... history ! WRITE( UNIT = stdout, FMT = 9010 ) WRITE( UNIT = stdout, FMT = 9020 ) ! CALL hinit0() CALL potinit() CALL newd() CALL wfcinit() ! ! ... this check is performed only once ! lcheck_mag = .FALSE. ! ! ... conv_ions is set to .FALSE. to perform a final scf cycle ! conv_ions = .FALSE. ! ELSE ! CALL terminate_bfgs( etot, stdout, tmp_dir ) ! END IF ! ELSE ! ! ... if a new bfgs step is done, new threshold is computed ! IF ( step_accepted ) THEN ! tr2 = starting_scf_threshold * & MIN( 1.D0, ( energy_error / ( epse * upscale ) ), & ( gradient_error / ( epsf * upscale ) ) ) tr2 = MAX( ( starting_scf_threshold / upscale ), tr2 ) ! END IF ! WRITE( stdout, '(5X,"new conv_thr",T30,"= ",F18.10,/)' ) tr2 ! ! ... the logical flag lcheck_mag is set again to .TRUE. (needed if ! ... a new configuration with zero zero absolute magnetization is ! ... identified in the following steps of the relaxation) ! lcheck_mag = .TRUE. ! END IF ! tau = RESHAPE( SOURCE = pos, SHAPE = (/ 3, nat /) ) / alat force = - RESHAPE( SOURCE = gradient, SHAPE = (/ 3, nat /) ) ! CALL output_tau( conv_ions ) ! DEALLOCATE( pos ) DEALLOCATE( gradient ) ! ELSE IF ( loldbfgs ) THEN ! ! ... the old bfgs scheme is used ! CALL bfgs() ! END IF ! ! ... molecular dynamics schemes are used ! IF ( lmd ) THEN ! IF ( calc == ' ' ) CALL dynamics() ! verlet dynamics IF ( calc /= ' ' ) CALL vcsmd() ! variable cell shape md ! END IF ! ! ... check if the new positions satisfy the constrain equation ! IF ( lconstrain ) CALL check_constrain() ! ! ... before leaving check that the new positions still transform ! ... according to the symmetry of the system. ! CALL checkallsym( nsym, s, nat, tau, ityp, & at, bg, nr1, nr2, nr3, irt, ftau ) ! history = MIN( 3, ( history + 1 ) ) ! ! ... find the best coefficients for the extrapolation of the potential ! CALL find_alpha_and_beta( nat, tau, tauold, alpha0, beta0 ) ! CALL seqopn( iunupdate, TRIM( prefix ) // '.update', 'FORMATTED', exst ) ! WRITE( UNIT = iunupdate, FMT = * ) history WRITE( UNIT = iunupdate, FMT = * ) tauold ! CLOSE( UNIT = iunupdate, STATUS = 'KEEP' ) ! DEALLOCATE( tauold ) ! END IF ! ! ... broadcast calculated quantities to all nodes ! CALL mp_bcast( conv_ions, ionode_id, intra_image_comm ) CALL mp_bcast( tau, ionode_id, intra_image_comm ) CALL mp_bcast( force, ionode_id, intra_image_comm ) CALL mp_bcast( tr2, ionode_id, intra_image_comm ) CALL mp_bcast( conv_ions, ionode_id, intra_image_comm ) CALL mp_bcast( alpha0, ionode_id, intra_image_comm ) CALL mp_bcast( beta0, ionode_id, intra_image_comm ) CALL mp_bcast( history, ionode_id, intra_image_comm ) ! RETURN ! 9010 FORMAT( /5X,'lsda relaxation : a final configuration with zero', & & /5X,' absolute magnetization has been found' ) 9020 FORMAT( /5X,'the program is checking if it is really ', & & 'the minimum energy structure', & & /5X,'by performing a new scf iteration', & & 'without any "electronic" history' ) ! CONTAINS ! ! ... internal procedures ! !----------------------------------------------------------------------- SUBROUTINE impose_constrains() !----------------------------------------------------------------------- ! USE constraints_module, ONLY : nconstr ! IMPLICIT NONE ! ! ... local variables ! INTEGER :: index, na REAL(KIND=DP) :: gv REAL(KIND=DP) :: dgv(3,nat) REAL(KIND=DP) :: dgv2 ! gv = 0 defines the constrain ! the gradient of gv ! its square modulus ! ! IF ( lbfgs ) THEN ! ! ... BFGS case: a penalty function is used ! CALL compute_penalty( gv, dgv, dgv2 ) ! etot = etot + lambda * gv**2 ! force(:,:) = force(:,:) - 2.D0 * lambda * gv * dgv(:,:) ! ELSE IF ( lmd ) THEN ! ! ... molecular dynamics case: lagrange multipliers are used ! ! ... find the constrained forces ! DO index = 1, nconstr ! CALL dist_constrain( index, gv, dgv, dgv2 ) ! CALL new_force( dgv, dgv2 ) ! END DO ! WRITE( stdout, '(/5x,"Constrained forces")') ! DO na = 1, nat ! WRITE( stdout, '(3F14.8)') force(:,na) ! END DO ! END IF ! END SUBROUTINE impose_constrains ! ! !----------------------------------------------------------------------- SUBROUTINE compute_lambda() !----------------------------------------------------------------------- ! USE constraints_module, ONLY : constr_tol ! IMPLICIT NONE ! ! ... local variables ! LOGICAL :: ltest REAL(KIND=DP) :: gv REAL(KIND=DP) :: dgv(3,nat) REAL(KIND=DP) :: dgv2 ! gv = 0 defines the constrain ! the gradient of gv ! its square modulus ! ! CALL compute_penalty( gv, dgv, dgv2 ) ! IF ( step_accepted ) THEN ! lambda_loop: DO ! IF ( ABS( gv ) > constr_tol ) lambda = lambda * 1.1D0 ! ltest = .TRUE. ! DO na = 1, nat ! IF ( 2.D0 * lambda * gv * norm( dgv(:,na) ) > 0.05D0 ) & ltest = .FALSE. ! END DO ! IF ( ltest ) EXIT lambda_loop ! lambda = lambda * 0.5D0 ! END DO lambda_loop ! END IF ! WRITE( stdout, '("LAMBDA = ",F14.10)' ) lambda WRITE( stdout, '("GV = ",F14.10)' ) gv WRITE( stdout, '("PENALTY = ",F14.10)' ) lambda * gv**2 ! RETURN ! END SUBROUTINE compute_lambda ! END SUBROUTINE move_ions ! ! ... this routine is used also by compute_scf (NEB) ! !---------------------------------------------------------------------------- SUBROUTINE find_alpha_and_beta( nat, tau, tauold, alpha0, beta0 ) !---------------------------------------------------------------------------- ! ! ... This routine finds the best coefficients alpha0 and beta0 so that ! ! ... | tau(t+dt) - tau' | is minimum, where ! ! ... tau' = tau(t) + alpha0 * ( tau(t) - tau(t-dt) ) ! ... + beta0 * ( tau(t-dt) -tau(t-2*dt) ) ! USE constants, ONLY : eps8 USE kinds, ONLY : DP USE io_global, ONLY : stdout USE control_flags, ONLY : order, history ! IMPLICIT NONE ! INTEGER :: nat, na, ipol REAL(KIND=DP) :: chi, alpha0, beta0, tau(3,nat), tauold(3,nat,3) REAL(KIND=DP) :: a11, a12, a21, a22, b1, b2, c, det ! ! IF ( MIN( history, order ) < 2 ) THEN ! RETURN ! ELSE IF ( MIN( history, order ) == 2 ) THEN ! alpha0 = 1.D0 beta0 = 0.D0 ! RETURN ! END IF ! ! ... solution of the linear system ! a11 = 0.D0 a12 = 0.D0 a21 = 0.D0 a22 = 0.D0 b1 = 0.D0 b2 = 0.D0 c = 0.D0 ! DO na = 1, nat ! DO ipol = 1, 3 ! a11 = a11 + ( tauold(ipol,na,1) - tauold(ipol,na,2) )**2 ! a12 = a12 + ( tauold(ipol,na,1) - tauold(ipol,na,2) ) * & ( tauold(ipol,na,2) - tauold(ipol,na,3) ) ! a22 = a22 + ( tauold(ipol,na,2) - tauold(ipol,na,3) )**2 ! b1 = b1 - ( tauold(ipol,na,1) - tau(ipol,na) ) * & ( tauold(ipol,na,1) - tauold(ipol,na,2) ) ! b2 = b2 - ( tauold(ipol,na,1) - tau(ipol,na) ) * & ( tauold(ipol,na,2) - tauold(ipol,na,3) ) ! c = c + ( tauold(ipol,na,1) - tau(ipol,na) )**2 ! END DO ! END DO ! a21 = a12 ! det = a11 * a22 - a12 * a21 ! IF ( det < - eps8 ) THEN ! alpha0 = 0.D0 beta0 = 0.D0 ! WRITE( UNIT = stdout, & FMT = '(5X,"WARNING: in find_alpha_and_beta det = ",F10.6)' ) det ! END IF ! ! ... case det > 0: a well defined minimum exists ! IF ( det > eps8 ) THEN ! alpha0 = ( b1 * a22 - b2 * a12 ) / det beta0 = ( a11 * b2 - a21 * b1 ) / det ! ELSE ! ! ... case det = 0 : the two increments are linearly dependent, ! ... chose solution with alpha = 0 and beta = 0 ! ... ( discard oldest configuration ) ! alpha0 = 0.D0 beta0 = 0.D0 ! IF ( a11 > 0.D0 ) alpha0 = b1 / a11 ! END IF ! chi = 0.D0 ! DO na = 1, nat ! DO ipol = 1, 3 ! chi = chi + ( ( 1.D0 + alpha0 ) * tauold(ipol,na,1) + & ( beta0 - alpha0 ) * tauold(ipol,na,2) - & beta0 * tauold(ipol, na, 3) - tau(ipol,na) )**2 ! END DO ! END DO ! #if defined (__DEBUG_EXTR) PRINT *, "" PRINT *, "chi = ", chi, " det = ", det PRINT *, "alpha = ", alpha0, " beta = ", beta0 PRINT *, "" PRINT *, "PREDICTED POSITIONS:" PRINT *, tauold(1,:,1) + alpha0 * ( tauold(1,:,1) - tauold(1,:,2) ) + & beta0 * ( tauold(1,:,2) - tauold(1,:,3) ) PRINT *, "" #endif ! RETURN ! END SUBROUTINE find_alpha_and_beta