2004-11-25 22:51:47 +08:00
|
|
|
!
|
2005-05-17 03:19:04 +08:00
|
|
|
! Copyright (C) 2002-2005 FPMD-CPV groups
|
2004-11-25 22:51:47 +08:00
|
|
|
! 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 .
|
|
|
|
!
|
2005-10-20 23:22:12 +08:00
|
|
|
!
|
2008-12-15 20:01:06 +08:00
|
|
|
SUBROUTINE from_scratch( )
|
2006-02-20 07:29:28 +08:00
|
|
|
!
|
|
|
|
USE kinds, ONLY : DP
|
|
|
|
USE control_flags, ONLY : tranp, trane, iprsta, tpre, tcarpar, &
|
|
|
|
tzeroc, tzerop, tzeroe, tfor, thdyn, &
|
|
|
|
lwf, tprnfor, tortho, amprp, ampre, &
|
2009-11-22 16:26:59 +08:00
|
|
|
tsde, ortho_eps, ortho_max, &
|
2009-11-10 00:07:19 +08:00
|
|
|
force_pairing
|
2008-12-15 20:01:06 +08:00
|
|
|
USE ions_positions, ONLY : taus, tau0, tausm, vels, fion, fionm, atoms0
|
2006-02-20 07:29:28 +08:00
|
|
|
USE ions_base, ONLY : na, nsp, randpos, zv, ions_vel, pmass
|
2007-03-05 18:16:05 +08:00
|
|
|
USE ions_base, ONLY : taui, cdmi, nat, iforce
|
|
|
|
USE ions_nose, ONLY : xnhp0, xnhpm, vnhp
|
2006-02-20 07:29:28 +08:00
|
|
|
USE cell_base, ONLY : ainv, h, s_to_r, ibrav, omega, press, &
|
|
|
|
hold, r_to_s, deth, wmass, iforceh, &
|
2007-04-26 17:24:37 +08:00
|
|
|
cell_force, boxdimensions, velh, a1, &
|
2008-12-15 20:01:06 +08:00
|
|
|
a2, a3, b1, b2, b3
|
2007-03-05 18:16:05 +08:00
|
|
|
USE cell_nose, ONLY : xnhh0, xnhhm, vnhh
|
|
|
|
USE electrons_nose, ONLY : xnhe0, xnhem, vnhe
|
|
|
|
use electrons_base, ONLY : nbsp, f, nspin, nupdwn, iupdwn
|
2006-08-04 01:47:35 +08:00
|
|
|
USE electrons_module, ONLY : occn_info
|
2007-03-05 18:16:05 +08:00
|
|
|
USE energies, ONLY : entropy, eself, enl, ekin, enthal, etot, ekincm
|
2006-02-20 07:29:28 +08:00
|
|
|
USE energies, ONLY : dft_energy_type, debug_energies
|
2007-03-05 18:16:05 +08:00
|
|
|
USE dener, ONLY : denl, denl6, dekin6, detot
|
2007-07-18 18:23:06 +08:00
|
|
|
USE uspp, ONLY : vkb, becsum, deeq, nkb, okvan
|
2006-02-20 07:29:28 +08:00
|
|
|
USE io_global, ONLY : stdout, ionode
|
2008-12-15 20:01:06 +08:00
|
|
|
USE core, ONLY : nlcc_any, rhoc
|
2006-02-20 07:29:28 +08:00
|
|
|
USE gvecw, ONLY : ngw
|
|
|
|
USE gvecs, ONLY : ngs
|
|
|
|
USE gvecp, ONLY : ngm
|
2007-03-05 18:16:05 +08:00
|
|
|
USE reciprocal_vectors, ONLY : gstart, mill_l, gx
|
2006-02-20 07:29:28 +08:00
|
|
|
USE cvan, ONLY : nvb
|
|
|
|
USE cp_electronic_mass, ONLY : emass
|
2007-03-05 18:16:05 +08:00
|
|
|
USE efield_module, ONLY : tefield, efield_berry_setup, berry_energy, &
|
|
|
|
tefield2, efield_berry_setup2, berry_energy2
|
2006-02-20 07:29:28 +08:00
|
|
|
USE cg_module, ONLY : tcg
|
|
|
|
USE ensemble_dft, ONLY : tens, compute_entropy
|
2006-12-31 19:09:03 +08:00
|
|
|
USE cp_interfaces, ONLY : runcp_uspp, runcp_uspp_force_pairing, &
|
2007-03-05 18:16:05 +08:00
|
|
|
strucf, phfacs, nlfh
|
2008-08-22 01:01:46 +08:00
|
|
|
USE cp_interfaces, ONLY : rhoofr, ortho, wave_rand_init, elec_fakekine
|
2009-11-22 16:26:59 +08:00
|
|
|
USE cp_interfaces, ONLY : compute_stress
|
2009-11-26 07:18:01 +08:00
|
|
|
USE cp_interfaces, ONLY : print_lambda
|
2007-03-05 18:16:05 +08:00
|
|
|
USE printout_base, ONLY : printout_pos
|
2006-02-20 07:29:28 +08:00
|
|
|
USE orthogonalize_base, ONLY : updatc, calphi
|
|
|
|
USE atoms_type_module, ONLY : atoms_type
|
|
|
|
USE wave_base, ONLY : wave_steepest
|
2006-06-01 18:51:33 +08:00
|
|
|
USE wavefunctions_module, ONLY : c0, cm, phi => cp
|
2006-02-20 07:29:28 +08:00
|
|
|
USE grid_dimensions, ONLY : nr1, nr2, nr3
|
2007-03-05 18:16:05 +08:00
|
|
|
USE time_step, ONLY : delt
|
2008-12-15 20:01:06 +08:00
|
|
|
USE cp_main_variables, ONLY : setval_lambda, descla, bephi, becp, becdr, nfi, &
|
|
|
|
sfac, eigr, ei1, ei2, ei3, bec, taub, irb, eigrb, &
|
|
|
|
lambda, lambdam, lambdap, ema0bg, rhog, rhor, rhos, &
|
2009-01-13 01:25:16 +08:00
|
|
|
vpot, ht0, edft, nlax
|
2007-01-05 23:32:43 +08:00
|
|
|
USE mp_global, ONLY : np_ortho, me_ortho, ortho_comm
|
2007-04-26 17:24:37 +08:00
|
|
|
USE small_box, ONLY : ainvb
|
2008-12-15 20:01:06 +08:00
|
|
|
USE cdvan, ONLY : dbec
|
2006-02-20 07:29:28 +08:00
|
|
|
!
|
|
|
|
IMPLICIT NONE
|
|
|
|
!
|
|
|
|
REAL(DP), ALLOCATABLE :: emadt2(:), emaver(:)
|
|
|
|
COMPLEX(DP), ALLOCATABLE :: c2(:), c3(:)
|
|
|
|
REAL(DP) :: verl1, verl2
|
|
|
|
REAL(DP) :: bigr, dum
|
|
|
|
INTEGER :: i, j, iter, iss, ierr, nspin_wfc
|
|
|
|
LOGICAL :: tlast = .FALSE.
|
|
|
|
REAL(DP) :: gam(1,1,1)
|
|
|
|
REAL(DP) :: fcell(3,3), ccc, enb, enbi, fccc
|
|
|
|
LOGICAL :: ttforce
|
|
|
|
LOGICAL :: tstress
|
|
|
|
LOGICAL, PARAMETER :: ttprint = .TRUE.
|
2006-03-17 01:58:40 +08:00
|
|
|
REAL(DP) :: ei_unp
|
2007-03-05 18:16:05 +08:00
|
|
|
REAL(DP) :: dt2bye
|
2006-03-17 01:58:40 +08:00
|
|
|
INTEGER :: n_spin_start
|
2007-03-05 18:16:05 +08:00
|
|
|
LOGICAL :: tfirst = .TRUE.
|
|
|
|
REAL(DP) :: stress(3,3)
|
2009-01-13 01:25:16 +08:00
|
|
|
INTEGER :: i1, i2
|
2006-02-20 07:29:28 +08:00
|
|
|
!
|
2008-12-15 20:01:06 +08:00
|
|
|
! ... Subroutine body
|
|
|
|
!
|
|
|
|
nfi = 0
|
|
|
|
!
|
2006-02-20 07:29:28 +08:00
|
|
|
ttforce = tfor .or. tprnfor
|
|
|
|
tstress = thdyn .or. tpre
|
|
|
|
!
|
2007-03-05 18:16:05 +08:00
|
|
|
stress = 0.0d0
|
|
|
|
!
|
2006-02-20 07:29:28 +08:00
|
|
|
IF( tsde ) THEN
|
|
|
|
fccc = 1.0d0
|
|
|
|
ELSE
|
|
|
|
fccc = 0.5d0
|
|
|
|
END IF
|
|
|
|
!
|
2007-03-05 18:16:05 +08:00
|
|
|
dt2bye = delt * delt / emass
|
|
|
|
!
|
2006-02-20 07:29:28 +08:00
|
|
|
IF( ANY( tranp( 1:nsp ) ) ) THEN
|
|
|
|
!
|
|
|
|
CALL invmat( 3, h, ainv, deth )
|
|
|
|
!
|
|
|
|
CALL randpos( taus, na, nsp, tranp, amprp, ainv, iforce )
|
|
|
|
!
|
|
|
|
CALL s_to_r( taus, tau0, na, nsp, h )
|
|
|
|
!
|
|
|
|
END IF
|
|
|
|
!
|
2008-12-15 20:01:06 +08:00
|
|
|
CALL phfacs( ei1, ei2, ei3, eigr, mill_l, atoms0%taus, nr1, nr2, nr3, atoms0%nat )
|
2006-06-01 18:51:33 +08:00
|
|
|
!
|
|
|
|
CALL strucf( sfac, ei1, ei2, ei3, mill_l, ngs )
|
2006-02-20 07:29:28 +08:00
|
|
|
!
|
2008-01-12 22:32:28 +08:00
|
|
|
IF ( okvan .OR. nlcc_any ) THEN
|
2007-07-18 18:23:06 +08:00
|
|
|
CALL initbox ( tau0, taub, irb, ainv, a1, a2, a3 )
|
|
|
|
CALL phbox( taub, eigrb, ainvb )
|
|
|
|
END IF
|
2006-06-01 18:51:33 +08:00
|
|
|
!
|
2007-07-18 18:23:06 +08:00
|
|
|
! wfc initialization with random numbers
|
2006-02-20 07:29:28 +08:00
|
|
|
!
|
2006-07-17 17:15:34 +08:00
|
|
|
CALL wave_rand_init( cm, nbsp, 1 )
|
2006-06-01 18:51:33 +08:00
|
|
|
!
|
2006-02-20 07:29:28 +08:00
|
|
|
IF ( ionode ) &
|
|
|
|
WRITE( stdout, fmt = '(//,3X, "Wave Initialization: random initial wave-functions" )' )
|
|
|
|
!
|
2006-06-26 15:51:38 +08:00
|
|
|
! ... prefor calculates vkb (used by gram)
|
|
|
|
!
|
|
|
|
CALL prefor( eigr, vkb )
|
2006-06-01 18:51:33 +08:00
|
|
|
!
|
2006-07-17 17:15:34 +08:00
|
|
|
nspin_wfc = nspin
|
|
|
|
IF( force_pairing ) nspin_wfc = 1
|
2006-02-20 07:29:28 +08:00
|
|
|
|
2006-07-17 17:15:34 +08:00
|
|
|
DO iss = 1, nspin_wfc
|
|
|
|
!
|
|
|
|
CALL gram( vkb, bec, nkb, cm(1,iupdwn(iss)), ngw, nupdwn(iss) )
|
|
|
|
!
|
|
|
|
END DO
|
2006-02-20 07:29:28 +08:00
|
|
|
|
2006-07-17 22:10:42 +08:00
|
|
|
IF( force_pairing ) cm(:,iupdwn(2):iupdwn(2)+nupdwn(2)-1) = cm(:,1:nupdwn(2))
|
2006-02-20 07:29:28 +08:00
|
|
|
!
|
2006-08-11 16:29:52 +08:00
|
|
|
if( iprsta >= 3 ) CALL dotcsc( eigr, cm, ngw, nbsp )
|
2006-06-26 15:51:38 +08:00
|
|
|
!
|
2006-02-20 07:29:28 +08:00
|
|
|
! ... initialize bands
|
|
|
|
!
|
2006-08-04 01:47:35 +08:00
|
|
|
CALL occn_info( f )
|
2006-02-20 07:29:28 +08:00
|
|
|
!
|
2008-12-15 20:01:06 +08:00
|
|
|
atoms0%for = 0.D0
|
|
|
|
atoms0%vels = 0.D0
|
2006-02-20 07:29:28 +08:00
|
|
|
hold = h
|
|
|
|
velh = 0.0d0
|
|
|
|
fion = 0.0d0
|
|
|
|
tausm = taus
|
2008-08-22 01:01:46 +08:00
|
|
|
!
|
|
|
|
! ... compute local form factors
|
|
|
|
!
|
2006-02-20 07:29:28 +08:00
|
|
|
CALL formf( tfirst, eself )
|
|
|
|
!
|
|
|
|
edft%eself = eself
|
|
|
|
|
|
|
|
IF( tefield ) THEN
|
|
|
|
CALL efield_berry_setup( eigr, tau0 )
|
|
|
|
END IF
|
|
|
|
IF( tefield2 ) THEN
|
|
|
|
CALL efield_berry_setup2( eigr, tau0 )
|
|
|
|
END IF
|
|
|
|
!
|
2008-08-22 01:01:46 +08:00
|
|
|
IF( .NOT. tcg ) THEN
|
|
|
|
!
|
|
|
|
CALL calbec ( 1, nsp, eigr, cm, bec )
|
|
|
|
!
|
|
|
|
if ( tstress ) CALL caldbec( ngw, nkb, nbsp, 1, nsp, eigr, cm, dbec )
|
|
|
|
!
|
|
|
|
CALL rhoofr ( nfi, cm(:,:), irb, eigrb, bec, becsum, rhor, rhog, rhos, enl, denl, ekin, dekin6 )
|
|
|
|
!
|
|
|
|
edft%enl = enl
|
|
|
|
edft%ekin = ekin
|
|
|
|
!
|
|
|
|
END IF
|
|
|
|
!
|
|
|
|
! put core charge (if present) in rhoc(r)
|
|
|
|
!
|
|
|
|
if ( nlcc_any ) CALL set_cc( irb, eigrb, rhoc )
|
2006-02-20 07:29:28 +08:00
|
|
|
!
|
|
|
|
|
|
|
|
IF( .NOT. tcg ) THEN
|
|
|
|
|
|
|
|
IF( tens ) THEN
|
|
|
|
CALL compute_entropy( entropy, f(1), nspin )
|
|
|
|
entropy = entropy * nbsp
|
|
|
|
END IF
|
2007-03-05 18:16:05 +08:00
|
|
|
!
|
|
|
|
vpot = rhor
|
|
|
|
!
|
|
|
|
CALL vofrho( nfi, vpot, rhog, rhos, rhoc, tfirst, tlast, &
|
|
|
|
& ei1, ei2, ei3, irb, eigrb, sfac, tau0, fion )
|
2006-02-20 07:29:28 +08:00
|
|
|
|
|
|
|
IF( tefield ) THEN
|
2006-07-17 17:15:34 +08:00
|
|
|
CALL berry_energy( enb, enbi, bec, cm(:,:), fion )
|
2006-02-20 07:29:28 +08:00
|
|
|
etot = etot + enb + enbi
|
|
|
|
END IF
|
|
|
|
IF( tefield2 ) THEN
|
2006-07-17 17:15:34 +08:00
|
|
|
CALL berry_energy2( enb, enbi, bec, cm(:,:), fion )
|
2006-02-20 07:29:28 +08:00
|
|
|
etot = etot + enb + enbi
|
|
|
|
END IF
|
|
|
|
|
|
|
|
CALL compute_stress( stress, detot, h, omega )
|
|
|
|
|
2007-03-05 18:16:05 +08:00
|
|
|
if(iprsta.gt.2) &
|
|
|
|
CALL printout_pos( stdout, fion, nat, head = ' fion ' )
|
2006-02-20 07:29:28 +08:00
|
|
|
|
2007-03-05 18:16:05 +08:00
|
|
|
CALL newd( vpot, irb, eigrb, becsum, fion )
|
2006-06-26 15:51:38 +08:00
|
|
|
!
|
2006-03-17 01:58:40 +08:00
|
|
|
IF( force_pairing ) THEN
|
2006-06-01 18:51:33 +08:00
|
|
|
!
|
2006-08-04 01:47:35 +08:00
|
|
|
CALL runcp_uspp_force_pairing( nfi, fccc, ccc, ema0bg, dt2bye, rhos, bec, cm, &
|
|
|
|
& c0, ei_unp, fromscra = .TRUE. )
|
2007-01-05 23:32:43 +08:00
|
|
|
!
|
|
|
|
CALL setval_lambda( lambda(:,:,2), nupdwn(1), nupdwn(1), 0.d0, descla(:,1) )
|
2006-06-01 18:51:33 +08:00
|
|
|
!
|
2006-03-17 01:58:40 +08:00
|
|
|
ELSE
|
|
|
|
!
|
2006-12-31 19:09:03 +08:00
|
|
|
CALL runcp_uspp( nfi, fccc, ccc, ema0bg, dt2bye, rhos, bec, cm, c0, fromscra = .TRUE. )
|
2006-06-01 18:51:33 +08:00
|
|
|
!
|
2006-03-17 01:58:40 +08:00
|
|
|
ENDIF
|
2006-02-20 07:29:28 +08:00
|
|
|
!
|
|
|
|
! nlfq needs deeq bec
|
|
|
|
!
|
2008-08-22 01:01:46 +08:00
|
|
|
if( ttforce ) CALL nlfq( cm, eigr, bec, becdr, fion )
|
2006-02-20 07:29:28 +08:00
|
|
|
!
|
|
|
|
! calphi calculates phi
|
|
|
|
! the electron mass rises with g**2
|
|
|
|
!
|
|
|
|
CALL calphi( cm, ngw, bec, nkb, vkb, phi, nbsp, ema0bg )
|
2006-03-17 01:58:40 +08:00
|
|
|
!
|
|
|
|
IF( force_pairing ) &
|
2006-07-17 17:15:34 +08:00
|
|
|
& phi( :, iupdwn(2):(iupdwn(2)+nupdwn(2)-1) ) = phi( :, 1:nupdwn(2))
|
2006-03-17 01:58:40 +08:00
|
|
|
|
2006-02-20 07:29:28 +08:00
|
|
|
|
|
|
|
if( tortho ) then
|
2007-01-05 23:32:43 +08:00
|
|
|
CALL ortho( eigr, c0, phi, ngw, lambda, descla, &
|
2006-06-22 18:05:15 +08:00
|
|
|
bigr, iter, ccc, bephi, becp, nbsp, nspin, nupdwn, iupdwn )
|
2006-02-20 07:29:28 +08:00
|
|
|
else
|
|
|
|
CALL gram( vkb, bec, nkb, c0, ngw, nbsp )
|
|
|
|
endif
|
|
|
|
!
|
|
|
|
!
|
2008-08-22 01:01:46 +08:00
|
|
|
if ( ttforce ) CALL nlfl( bec, becdr, lambda, fion )
|
2006-02-20 07:29:28 +08:00
|
|
|
|
|
|
|
if ( iprsta >= 3 ) CALL print_lambda( lambda, nbsp, 9, ccc )
|
|
|
|
|
2008-08-22 01:01:46 +08:00
|
|
|
if ( tstress ) CALL nlfh( stress, bec, dbec, lambda )
|
2006-02-20 07:29:28 +08:00
|
|
|
!
|
|
|
|
IF ( tortho ) THEN
|
2006-07-17 17:15:34 +08:00
|
|
|
DO iss = 1, nspin_wfc
|
2009-01-13 01:25:16 +08:00
|
|
|
i1 = (iss-1)*nlax+1
|
|
|
|
i2 = iss*nlax
|
2006-02-20 07:29:28 +08:00
|
|
|
CALL updatc( ccc, nbsp, lambda(:,:,iss), SIZE(lambda,1), phi, SIZE(phi,1), &
|
2009-01-13 01:25:16 +08:00
|
|
|
bephi(:,i1:i2), SIZE(bephi,1), becp, bec, c0, nupdwn(iss), iupdwn(iss), &
|
2007-01-05 23:32:43 +08:00
|
|
|
descla(:,iss) )
|
2006-02-20 07:29:28 +08:00
|
|
|
END DO
|
|
|
|
END IF
|
|
|
|
!
|
2006-03-17 01:58:40 +08:00
|
|
|
IF( force_pairing ) THEN
|
2006-06-01 18:51:33 +08:00
|
|
|
!
|
2006-07-17 17:15:34 +08:00
|
|
|
c0 ( :, iupdwn(2):(iupdwn(2)+nupdwn(2)-1) ) = c0( :, 1:nupdwn(2))
|
|
|
|
phi( :, iupdwn(2):(iupdwn(2)+nupdwn(2)-1) ) = phi( :, 1:nupdwn(2))
|
2007-01-05 23:32:43 +08:00
|
|
|
lambda(:,:,2) = lambda(:,:,1)
|
2006-06-01 18:51:33 +08:00
|
|
|
!
|
2006-03-17 01:58:40 +08:00
|
|
|
ENDIF
|
|
|
|
!
|
2006-02-20 07:29:28 +08:00
|
|
|
CALL calbec ( nvb+1, nsp, eigr, c0, bec )
|
|
|
|
|
2008-08-22 01:01:46 +08:00
|
|
|
if ( tstress ) CALL caldbec( ngw, nkb, nbsp, 1, nsp, eigr, cm, dbec )
|
2006-02-20 07:29:28 +08:00
|
|
|
|
2006-08-11 16:29:52 +08:00
|
|
|
if ( iprsta >= 3 ) CALL dotcsc( eigr, c0, ngw, nbsp )
|
|
|
|
!
|
|
|
|
xnhp0 = 0.0d0
|
|
|
|
xnhpm = 0.0d0
|
|
|
|
vnhp = 0.0d0
|
|
|
|
fionm = 0.0d0
|
2006-02-20 07:29:28 +08:00
|
|
|
!
|
|
|
|
CALL ions_vel( vels, taus, tausm, na, nsp, delt )
|
2006-08-11 16:29:52 +08:00
|
|
|
!
|
|
|
|
xnhh0(:,:) = 0.0d0
|
|
|
|
xnhhm(:,:) = 0.0d0
|
|
|
|
vnhh (:,:) = 0.0d0
|
|
|
|
velh (:,:) = ( h(:,:) - hold(:,:) ) / delt
|
2006-02-20 07:29:28 +08:00
|
|
|
!
|
2006-06-22 18:05:15 +08:00
|
|
|
CALL elec_fakekine( ekincm, ema0bg, emass, c0, cm, ngw, nbsp, 1, delt )
|
2006-02-20 07:29:28 +08:00
|
|
|
|
2006-08-11 16:29:52 +08:00
|
|
|
xnhe0 = 0.0d0
|
|
|
|
xnhem = 0.0d0
|
|
|
|
vnhe = 0.0d0
|
2006-02-20 07:29:28 +08:00
|
|
|
|
|
|
|
lambdam = lambda
|
|
|
|
!
|
|
|
|
ELSE
|
|
|
|
!
|
|
|
|
c0 = cm
|
|
|
|
!
|
|
|
|
END IF
|
|
|
|
!
|
|
|
|
RETURN
|
|
|
|
!
|
2008-12-15 20:01:06 +08:00
|
|
|
END SUBROUTINE from_scratch
|