scnc
/
quantum-espresso
mirror of https://gitlab.com/QEF/q-e.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

old neb files erased from PW dir. flag changed with lflag in stop_run 

and close_files. dealloc london and constraints arrays moved to
clean_pw. Stop_run is calling as in the past environment_end and mp_global_end.


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@7195 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
marsamos 2010-11-05 17:06:02 +00:00
parent a8616efe50
commit 0d6f6390be
7 changed files with 25 additions and 975 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
PW/clean_pw.f90
View File

@ -44,10 +44,15 @@ SUBROUTINE clean_pw( lflag )
USE radial_grids, ONLY : deallocate_radial_grid
USE wannier_new, ONLY : use_wannier
!
USE london_module, ONLY : dealloca_london
USE constraints_module, ONLY : deallocate_constraint
!
IMPLICIT NONE
!
LOGICAL, INTENT(IN) :: lflag
! if .TRUE. ion-related variables are also deallocated
! as well as arrays allocated in iosys.
! --> .TRUE. means the real end!!!
! .FALSE. in neb, smd, phonon calculations
!
! ... arrays allocated in input.f90, read_file.f90 or setup.f90
@ -60,6 +65,10 @@ SUBROUTINE clean_pw( lflag )
IF ( ALLOCATED( forcefield ) ) DEALLOCATE( forcefield )
IF ( ALLOCATED (irt) ) DEALLOCATE (irt)
!
CALL deallocate_bp_efield()
CALL dealloca_london()
CALL deallocate_constraint()
!
END IF
!
IF ( ALLOCATED( f_inp ) ) DEALLOCATE( f_inp )

6
PW/close_files.f90
View File

@ -6,7 +6,7 @@
! or http://www.gnu.org/copyleft/gpl.txt .
!
!----------------------------------------------------------------------------
SUBROUTINE close_files(flag)
SUBROUTINE close_files(lflag)
!----------------------------------------------------------------------------
!
! ... Close all files and synchronize processes for a new scf calculation.
@ -24,13 +24,13 @@ SUBROUTINE close_files(flag)
!
IMPLICIT NONE
!
LOGICAL, intent(in) :: flag
LOGICAL, intent(in) :: lflag
!
LOGICAL :: opnd
! ... close buffer/file containing wavefunctions: discard if
! ... wavefunctions are written in xml format, save otherwise
!
IF ( flag .AND. (twfcollect .OR. io_level < 0 )) THEN
IF ( lflag .AND. (twfcollect .OR. io_level < 0 )) THEN
CALL close_buffer ( iunwfc, 'DELETE' )
ELSE
CALL close_buffer ( iunwfc, 'KEEP' )

535
PW/compute_fes_grads.f90
View File

@ -1,535 +0,0 @@
!
! Copyright (C) 2002-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 .
!
!
!----------------------------------------------------------------------------
SUBROUTINE compute_fes_grads( fii, lii, stat )
!----------------------------------------------------------------------------
!
USE kinds, ONLY : DP
USE constants, ONLY : e2
USE input_parameters, ONLY : startingwfc, startingpot, diago_thr_init
USE basis, ONLY : starting_wfc, starting_pot
USE metadyn_vars, ONLY : ncolvar, dfe_acc, new_target, to_target, &
to_new_target, sw_nstep, fe_nstep, eq_nstep
USE path_variables, ONLY : grad_fes => grad_pes, &
pos, num_of_images, istep_path, pending_image
USE constraints_module, ONLY : lagrange, constr_target, init_constraint, &
deallocate_constraint
USE control_flags, ONLY : istep, nstep, ethr, conv_ions, ldamped
USE cell_base, ONLY : alat, at
USE ions_base, ONLY : nat, tau, ityp
USE path_formats, ONLY : scf_fmt, scf_fmt_para
USE io_files, ONLY : prefix, tmp_dir, iunpath, iunaxsf, &
delete_if_present
USE constants, ONLY : bohr_radius_angs
USE io_global, ONLY : stdout, ionode, ionode_id, meta_ionode
USE mp_global, ONLY : inter_image_comm, intra_image_comm, &
my_image_id, nimage, root_image
USE mp, ONLY : mp_bcast, mp_barrier, mp_sum, mp_min
USE check_stop, ONLY : check_stop_now
USE path_io_routines, ONLY : new_image_init, get_new_image, &
stop_other_images
USE metadyn_base, ONLY : add_domain_potential
USE metadyn_io, ONLY : write_axsf_file
!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: fii, lii
LOGICAL, INTENT(OUT) :: stat
!
INTEGER :: i, image
REAL(DP) :: tcpu
CHARACTER(LEN=10) :: stage
INTEGER :: fe_step0, sw_step0
CHARACTER(LEN=256) :: tmp_dir_saved, filename, basename
LOGICAL :: lfirst_scf = .TRUE.
LOGICAL :: opnd, file_exists
LOGICAL :: ldamped_saved
!
CHARACTER(LEN=6), EXTERNAL :: int_to_char
REAL(DP), EXTERNAL :: get_clock
!
!
CALL flush_unit( iunpath )
!
tmp_dir_saved = tmp_dir
ldamped_saved = ldamped
!
! ... vectors fes and grad_fes are initalized to zero for all images on
! ... all nodes: this is needed for the final mp_sum()
!
IF ( my_image_id == root_image ) THEN
!
grad_fes(:,:) = 0.D0
!
ELSE
!
grad_fes(:,fii:lii) = 0.D0
!
END IF
!
! ... only the first cpu initializes the file needed by parallelization
! ... among images
!
IF ( meta_ionode ) CALL new_image_init( fii, tmp_dir_saved )
!
image = fii + my_image_id
!
! ... all processes are syncronized (needed to have an ordered output)
!
CALL mp_barrier()
!
fes_loop: DO
!
! ... exit if available images are finished
!
IF ( image > lii ) EXIT fes_loop
!
pending_image = image
!
IF ( check_stop_now( iunpath ) ) THEN
!
stat = .FALSE.
!
! ... in case of parallelization on images a stop signal
! ... is sent via the "EXIT" file
!
IF ( nimage > 1 ) CALL stop_other_images()
!
IF ( interrupt_run( stat ) ) RETURN
!
END IF
!
! ... calculation of the mean-force
!
tcpu = get_clock( 'PWSCF' )
!
IF ( nimage > 1 ) THEN
!
WRITE( UNIT = iunpath, FMT = scf_fmt_para ) my_image_id, tcpu, image
!
ELSE
!
WRITE( UNIT = iunpath, FMT = scf_fmt ) tcpu, image
!
END IF
!
tmp_dir = TRIM( tmp_dir_saved ) // TRIM( prefix ) // &
"_" // TRIM( int_to_char( image ) ) // "/"
!
basename = TRIM( tmp_dir ) // TRIM( prefix )
!
! ... unit stdout is connected to the appropriate file
!
IF ( ionode ) THEN
!
INQUIRE( UNIT = stdout, OPENED = opnd )
IF ( opnd ) CLOSE( UNIT = stdout )
OPEN( UNIT = stdout, FILE = TRIM( tmp_dir ) // 'PW.out', &
STATUS = 'UNKNOWN', POSITION = 'APPEND' )
!
END IF
!
filename = TRIM( tmp_dir ) // "therm_average.restart"
!
INQUIRE( FILE = filename, EXIST = file_exists )
!
IF ( file_exists ) THEN
!
! ... we read the previous positions, the value of the accumulators,
! ... and the number of steps already performed for this image from
! ... a restart file
!
IF ( ionode ) THEN
!
OPEN( UNIT = 1000, FILE = filename )
!
READ( 1000, * ) stage
READ( 1000, * ) tau(:,:)
READ( 1000, * ) nstep
READ( 1000, * ) to_target
READ( 1000, * ) dfe_acc
!
CLOSE( UNIT = 1000 )
!
END IF
!
CALL mp_bcast( stage, ionode_id, intra_image_comm )
CALL mp_bcast( tau, ionode_id, intra_image_comm )
CALL mp_bcast( nstep, ionode_id, intra_image_comm )
CALL mp_bcast( to_target, ionode_id, intra_image_comm )
CALL mp_bcast( dfe_acc, ionode_id, intra_image_comm )
!
ELSE
!
stage = 'tobedone'
!
END IF
!
CALL clean_pw( .FALSE. )
CALL deallocate_constraint()
!
CALL init_constraint( nat, tau, ityp, alat )
!
CALL setup ()
CALL init_run()
!
fe_step0 = 1
sw_step0 = 1
!
SELECT CASE( stage )
CASE( 'done' )
!
! ... do nothing and recompute the average quantities
!
CASE( 'tobedone' )
!
new_target(:) = pos(:,image)
!
to_target(:) = ( new_target(:) - &
constr_target(1:ncolvar) ) / DBLE( sw_nstep )
!
dfe_acc = 0.D0
!
stage = 'switch'
!
CASE( 'switch' )
!
dfe_acc = 0.D0
!
sw_step0 = nstep
!
CASE( 'mean-force' )
!
fe_step0 = nstep
!
CASE DEFAULT
!
CALL errore( 'compute_fes_grads', &
'stage ' // TRIM( stage ) // ' unknown', 1 )
!
END SELECT
!
IF ( stage == 'switch' ) THEN
!
! ... first the collective variables are "adiabatically" changed to
! ... the new vales by using MD without damping
!
WRITE( stdout, '(/,5X,"adiabatic switch of the system ", &
& "to the new coarse-grained positions",/)' )
!
CALL delete_if_present( TRIM( basename ) // '.md' )
CALL delete_if_present( TRIM( basename ) // '.update' )
!
ldamped = .FALSE.
lfirst_scf = .TRUE.
to_new_target = .TRUE.
!
nstep = sw_nstep
!
DO i = sw_step0, sw_nstep
!
CALL electronic_scf( lfirst_scf, stat )
!
IF ( interrupt_run( stat ) ) RETURN
!
lfirst_scf = .FALSE.
!
CALL move_ions()
!
END DO
!
ldamped = ldamped_saved
!
stage = 'mean-force'
!
CALL write_restart( 'mean-force', 0 )
!
END IF
!
IF ( stage == 'mean-force' ) THEN
!
! ... then the free energy gradients are computed
!
WRITE( stdout, '(/,5X,"calculation of the mean force",/)' )
!
CALL delete_if_present( TRIM( basename ) // '.md' )
CALL delete_if_present( TRIM( basename ) // '.bfgs' )
CALL delete_if_present( TRIM( basename ) // '.update' )
!
to_new_target = .FALSE.
!
nstep = fe_nstep
!
DO i = fe_step0, fe_nstep
!
CALL electronic_scf( .FALSE., stat )
!
IF ( interrupt_run( stat ) ) RETURN
!
CALL move_ions()
!
IF ( ldamped .AND. conv_ions ) EXIT
!
END DO
!
END IF
!
! ... the averages are computed here (converted to Hartree a.u.)
!
IF ( ldamped ) THEN
!
! ... zero temperature case
!
grad_fes(:,image) = - lagrange(1:ncolvar) / e2
!
ELSE
!
! ... finite temperature case
!
grad_fes(:,image) = dfe_acc(:) / DBLE( fe_nstep - eq_nstep ) / e2
!
END IF
!
! ... notice that grad_fes(:,image) have been computed, so far, by
! ... ionode only: here we broadcast to all the other cpus
!
CALL mp_bcast( grad_fes(:,image), ionode_id, intra_image_comm )
!
IF ( ionode ) THEN
!
! ... the restart file is written here
!
CALL write_restart( 'done', 0 )
!
END IF
!
! ... the new image is obtained (by ionode only)
!
CALL get_new_image( image, tmp_dir_saved )
!
CALL mp_bcast( image, ionode_id, intra_image_comm )
!
! ... input values are restored at the end of each iteration ( they are
! ... modified by init_run )
!
starting_pot = startingpot
starting_wfc = startingwfc
!
ethr = diago_thr_init
!
CALL close_files()
!
CALL reset_k_points ( )
!
END DO fes_loop
!
CALL mp_barrier()
!
IF ( meta_ionode ) THEN
!
! ... when all the images are done the stage is changed from
! ... 'done' to 'tobedone'
!
DO image = fii, lii
!
tmp_dir = TRIM( tmp_dir_saved ) // TRIM( prefix ) // &
& "_" // TRIM( int_to_char( image ) ) // "/"
!
filename = TRIM( tmp_dir ) // "therm_average.restart"
!
OPEN( UNIT = 1000, FILE = filename )
!
READ( 1000, * ) stage
READ( 1000, * ) tau(:,:)
READ( 1000, * ) nstep
READ( 1000, * ) to_target
READ( 1000, * ) dfe_acc
!
CLOSE( UNIT = 1000 )
!
CALL write_restart( 'tobedone', 0 )
!
END DO
!
! ... here the meta_ionode writes the axsf file for this iteration
! ... by reading the positions from the restart-file
!
filename = TRIM( prefix ) // "_" // &
& TRIM( int_to_char( istep_path + 1 ) ) // ".axsf"
!
OPEN( UNIT = iunaxsf, FILE = filename, ACTION = "WRITE" )
!
WRITE( UNIT = iunaxsf, FMT = '(" ANIMSTEPS ",I5)' ) num_of_images
WRITE( UNIT = iunaxsf, FMT = '(" CRYSTAL ")' )
WRITE( UNIT = iunaxsf, FMT = '(" PRIMVEC ")' )
WRITE( UNIT = iunaxsf, FMT = '(3F14.10)' ) &
at(1,1)*alat*bohr_radius_angs, &
at(2,1)*alat*bohr_radius_angs, &
at(3,1)*alat*bohr_radius_angs
WRITE( UNIT = iunaxsf, FMT = '(3F14.10)' ) &
at(1,2)*alat*bohr_radius_angs, &
at(2,2)*alat*bohr_radius_angs, &
at(3,2)*alat*bohr_radius_angs
WRITE( UNIT = iunaxsf, FMT = '(3F14.10)' ) &
at(1,3)*alat*bohr_radius_angs, &
at(2,3)*alat*bohr_radius_angs, &
at(3,3)*alat*bohr_radius_angs
!
DO image = 1, num_of_images
!
tmp_dir = TRIM( tmp_dir_saved ) // TRIM( prefix ) // &
& "_" // TRIM( int_to_char( image ) ) // "/"
!
filename = TRIM( tmp_dir ) // "therm_average.restart"
!
OPEN( UNIT = 1000, FILE = filename )
!
READ( 1000, * ) stage
READ( 1000, * ) tau(:,:)
!
CLOSE( UNIT = 1000 )
!
CALL write_axsf_file( image, tau, alat )
!
END DO
!
CLOSE( UNIT = iunaxsf )
!
END IF
!
CALL add_domain_potential()
!
tmp_dir = tmp_dir_saved
!
! ... after the first call to compute_fes_grads the input values of
! ... startingpot and startingwfc are both set to 'file'
!
startingpot = 'file'
startingwfc = 'file'
starting_pot= startingpot
starting_wfc= startingwfc
!
pending_image = 0
!
IF ( nimage > 1 ) THEN
!
! ... grad_fes is communicated among "image" pools
!
CALL mp_sum( grad_fes(:,fii:lii), inter_image_comm )
!
END IF
!
RETURN
!
CONTAINS
!
!------------------------------------------------------------------------
SUBROUTINE write_restart( stage, nstep )
!------------------------------------------------------------------------
!
CHARACTER(LEN=*), INTENT(IN) :: stage
INTEGER, INTENT(IN) :: nstep
!
OPEN( UNIT = 1000, FILE = filename )
!
WRITE( 1000, * ) TRIM( stage )
WRITE( 1000, * ) tau(:,:)
WRITE( 1000, * ) nstep
WRITE( 1000, * ) to_target
WRITE( 1000, * ) dfe_acc
!
CLOSE( UNIT = 1000 )
!
END SUBROUTINE write_restart
!
!------------------------------------------------------------------------
FUNCTION interrupt_run( stat )
!-----------------------------------------------------------------------
!
LOGICAL, INTENT(IN) :: stat
LOGICAL :: interrupt_run
!
interrupt_run = .NOT. stat
!
IF ( stat ) RETURN
!
pending_image = 1
!
filename = TRIM( prefix ) // "_" // &
& TRIM( int_to_char( istep_path + 1 ) ) // ".axsf"
!
CALL delete_if_present( TRIM( filename ) )
!
filename = TRIM( tmp_dir ) // "therm_average.restart"
!
CALL write_restart( stage, istep - 1 )
!
IF ( nimage > 1 ) CALL stop_other_images()
!
END FUNCTION interrupt_run
!
END SUBROUTINE compute_fes_grads
!
!----------------------------------------------------------------------------
SUBROUTINE reset_init_mag()
!----------------------------------------------------------------------------
!
USE dfunct, only : newd
IMPLICIT NONE
!
CALL hinit0()
CALL potinit()
CALL newd()
CALL wfcinit()
!
RETURN
!
END SUBROUTINE reset_init_mag
!
!----------------------------------------------------------------------------
SUBROUTINE electronic_scf( lfirst_scf, stat )
!----------------------------------------------------------------------------
!
USE control_flags, ONLY : conv_elec, ethr
USE io_files, ONLY : iunpath
USE io_global, ONLY : ionode
!
IMPLICIT NONE
!
LOGICAL, INTENT(IN) :: lfirst_scf
LOGICAL, INTENT(OUT) :: stat
!
!
IF ( .NOT. lfirst_scf ) THEN
!
ethr = 1.D-5
!
CALL hinit1()
!
END IF
!
CALL electrons()
!
stat = conv_elec
!
IF ( .NOT.conv_elec ) THEN
!
IF ( ionode ) &
WRITE( UNIT = iunpath, &
FMT = '(/,5X,"WARNING : scf convergence NOT achieved",/)' )
!
RETURN
!
END IF
!
CALL forces()
!
RETURN
!
END SUBROUTINE electronic_scf

414
PW/compute_scf.f90
View File

@ -1,414 +0,0 @@
!
! Copyright (C) 2002-2009 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 .
!
!
!----------------------------------------------------------------------------
SUBROUTINE compute_scf( fii, lii, stat )
!----------------------------------------------------------------------------
!
! ... this subroutine is the main scf-driver for all "path" calculations
! ... ( called by Modules/path_base.f90/born_oppenheimer() subroutine )
!
! ... for each image in the path, it performs the self-consistent loop
! ... computing the energy and the forces
!
! ... Written by Carlo Sbraccia (2003-2006)
!
USE input_parameters, ONLY : startingwfc, startingpot
USE basis, ONLY : starting_wfc, starting_pot
USE kinds, ONLY : DP
USE constants, ONLY : e2
USE control_flags, ONLY : conv_elec, istep, history, pot_order
USE check_stop, ONLY : check_stop_now
USE vlocal, ONLY : strf
USE cell_base, ONLY : bg, alat
USE gvect, ONLY : ngm, g, nr1, nr2, nr3, eigts1, eigts2, eigts3
USE ions_base, ONLY : tau, nat, nsp, ityp
USE ener, ONLY : etot
USE force_mod, ONLY : force
USE io_files, ONLY : prefix, tmp_dir, iunpath, iunupdate, &
exit_file, iunexit, delete_if_present
USE path_formats, ONLY : scf_fmt, scf_fmt_para
USE path_variables, ONLY : pos, pes, grad_pes, dim1, pending_image, &
istep_path, frozen, num_of_images, &
first_last_opt
USE io_global, ONLY : stdout, ionode, ionode_id, meta_ionode
USE mp_global, ONLY : inter_image_comm, intra_image_comm, &
my_image_id, nimage, root_image
USE mp, ONLY : mp_bcast, mp_barrier, mp_sum, mp_min
USE path_io_routines, ONLY : new_image_init, get_new_image, &
stop_other_images
!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: fii, lii ! indexes to first and last images
LOGICAL, INTENT(OUT) :: stat
!
INTEGER :: fii_, lii_ ! local copies of fii and lii
INTEGER :: image, istat
REAL(DP) :: tcpu
CHARACTER (LEN=256) :: tmp_dir_saved
LOGICAL :: file_exists, opnd
REAL(DP), ALLOCATABLE :: tauold(:,:,:)
! previous positions of atoms (needed by extrapolation)
!
CHARACTER(LEN=6), EXTERNAL :: int_to_char
!
!
fii_ = fii
lii_ = lii
!
istep = istep_path
istat = 0
!
CALL flush_unit( iunpath )
!
ALLOCATE( tauold( 3, nat, 3 ) )
!
tmp_dir_saved = tmp_dir
!
IF ( nimage > 1 ) THEN
!
! ... vectors pes and grad_pes are initalized to zero for all images on
! ... all nodes: this is needed for the final mp_sum()
!
IF ( my_image_id == root_image ) THEN
!
FORALL( image = fii:lii, .NOT.frozen(image) )
!
pes(image) = 0.D0
grad_pes(:,image) = 0.D0
!
END FORALL
!
ELSE
!
pes(fii:lii) = 0.D0
grad_pes(:,fii:lii) = 0.D0
!
END IF
!
END IF
!
! ... all processes are syncronized (needed to have a readable output)
!
CALL mp_barrier()
!
IF ( nimage > 1 .AND. .NOT.first_last_opt ) THEN
!
! ... self-consistency on the first and last images is done separately
!
IF ( fii == 1 ) THEN
!
IF ( my_image_id == root_image ) THEN
!
CALL do_scf( 1, istat )
!
IF ( istat /= 0 ) GOTO 1
!
END IF
!
fii_ = 2
!
END IF
IF ( lii == num_of_images ) THEN
!
IF ( my_image_id == root_image + 1 ) THEN
!
CALL do_scf( num_of_images, istat )
!
IF ( istat /= 0 ) GOTO 1
!
END IF
!
lii_ = lii - 1
!
END IF
!
END IF
!
! ... only the first cpu initializes the file needed by parallelization
! ... among images
!
IF ( meta_ionode ) CALL new_image_init( fii_, tmp_dir_saved )
!
image = fii_ + my_image_id
!
scf_loop: DO
!
! ... exit if available images are finished
!
IF ( image > lii_ ) EXIT scf_loop
!
pending_image = image
!
CALL do_scf( image, istat )
!
IF ( istat /= 0 ) GOTO 1
!
! ... the new image is obtained (by ionode only)
!
CALL get_new_image( image, tmp_dir_saved )
!
CALL mp_bcast( image, ionode_id, intra_image_comm )
!
END DO scf_loop
!
! ... after the first call to compute_scf the input values of startingpot
! ... and startingwfc are both set to 'file'
!
startingpot = 'file'
startingwfc = 'file'
starting_pot = startingpot
starting_wfc = startingwfc
!
! ... finalization of the job (this point is also reached in case of error
! ... condition)
!
1 CALL mp_barrier()
!
DEALLOCATE( tauold )
!
IF ( nimage > 1 ) THEN
!
! ... pes and grad_pes are communicated among "image" pools
!
CALL mp_sum( pes(fii:lii), inter_image_comm )
CALL mp_sum( grad_pes(:,fii:lii), inter_image_comm )
CALL mp_sum( istat, inter_image_comm )
!
END IF
!
! ... global status is computed here
!
IF ( istat == 0 ) THEN
!
stat = .TRUE.
!
pending_image = 0
!
ELSE
!
stat = .FALSE.
!
IF ( nimage > 1 ) THEN
!
CALL mp_min( pending_image, inter_image_comm )
!
IF ( meta_ionode ) CALL delete_if_present( exit_file )
!
END IF
!
IF ( meta_ionode ) THEN
!
! ... some image didn't converge: extrapolation is no longer
! ... possible, files are removed
!
WRITE( UNIT = iunpath, &
FMT = '(/,5X,"cleaning-up extrapolation files"/)' )
!
DO image = pending_image, lii
!
tmp_dir = TRIM( tmp_dir_saved ) // TRIM( prefix ) // "_" // &
TRIM( int_to_char( image ) ) // "/"
!
CALL delete_if_present( TRIM( tmp_dir ) // &
TRIM( prefix ) // '.update' )
!
END DO
!
END IF
!
END IF
!
tmp_dir = tmp_dir_saved
!
RETURN
!
CONTAINS
!
!-----------------------------------------------------------------------
SUBROUTINE do_scf( image, istat )
!-----------------------------------------------------------------------
!
USE input_parameters, ONLY : diago_thr_init
USE control_flags, ONLY : ethr
!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: image
INTEGER, INTENT(INOUT) :: istat
!
REAL(DP), EXTERNAL :: get_clock
!
! ... self-consistency ( for non-frozen images only )
!
IF ( frozen(image) ) RETURN
!
CALL clean_pw( .FALSE. )
!
tcpu = get_clock( 'PWSCF' )
!
IF ( nimage > 1 ) THEN
!
WRITE( UNIT = iunpath, FMT = scf_fmt_para ) my_image_id, tcpu, image
!
ELSE
!
WRITE( UNIT = iunpath, FMT = scf_fmt ) tcpu, image
!
END IF
!
tmp_dir = TRIM( tmp_dir_saved ) // TRIM( prefix ) // "_" // &
TRIM( int_to_char( image ) ) // "/"
!
! ... unit stdout is connected to the appropriate file
!
IF ( ionode ) THEN
!
INQUIRE( UNIT = stdout, OPENED = opnd )
IF ( opnd ) CLOSE( UNIT = stdout )
OPEN( UNIT = stdout, FILE = TRIM( tmp_dir ) // 'PW.out', &
STATUS = 'UNKNOWN', POSITION = 'APPEND' )
!
END IF
!
! ... tau is in alat units ( pos is in bohr )
!
tau = RESHAPE( pos(:,image), SHAPE( tau ) ) / alat
!
WRITE( stdout, '(/,5X,"coordinates at iteration ",I3,/)' ) istep
!
CALL output_tau( .FALSE., .FALSE. )
!
! ... initialization of the scf calculation
!
CALL setup ()
CALL init_run()
!
IF ( ionode ) THEN
!
! ... the file containing old positions is opened
! ... ( needed for extrapolation )
!
CALL seqopn( iunupdate, 'update', 'FORMATTED', file_exists )
!
IF ( file_exists ) 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' )
!
END IF
!
CALL mp_bcast( history, ionode_id, intra_image_comm )
CALL mp_bcast( tauold, ionode_id, intra_image_comm )
!
IF ( history > 0 ) THEN
!
! ... potential and wavefunctions are extrapolated only if
! ... we are starting a new self-consistency ( scf on the
! ... previous image was achieved )
!
IF ( pot_order > 0 ) THEN
!
! ... structure factors of the old positions are computed
! ... (needed for the old atomic charge)
!
CALL struc_fact( nat, tauold(:,:,1), nsp, ityp, ngm, g, bg, &
nr1, nr2, nr3, strf, eigts1, eigts2, eigts3 )
!
END IF
!
CALL update_pot()
!
END IF
!
! ... self-consistency loop
!
CALL electrons()
!
CALL punch( 'all' )
!
! ... scf convergence is checked here
!
IF ( .NOT.conv_elec ) THEN
!
istat = 1
!
WRITE( UNIT = iunpath, &
FMT = '(/,5X,"WARNING : scf convergence ", &
& "NOT achieved on image ",I3)' ) image
!
! ... in case of parallelization on images a stop signal
! ... is sent via the "EXIT" file
!
IF ( nimage > 1 ) CALL stop_other_images()
!
RETURN
!
END IF
!
! ... self-consistent forces
!
CALL forces()
!
! ... energy is converted from rydberg to hartree
!
pes(image) = etot / e2
!
! ... gradients are converted from rydberg/bohr to hartree/bohr
!
grad_pes(:,image) = - RESHAPE( force, (/ dim1 /) ) / e2
!
IF ( ionode ) THEN
!
! ... save the previous two steps
! ... ( a total of three ionic steps is saved )
!
tauold(:,:,3) = tauold(:,:,2)
tauold(:,:,2) = tauold(:,:,1)
tauold(:,:,1) = tau(:,:)
!
history = MIN( 3, ( history + 1 ) )
!
CALL seqopn( iunupdate, 'update', 'FORMATTED', file_exists )
!
WRITE( UNIT = iunupdate, FMT = * ) history
WRITE( UNIT = iunupdate, FMT = * ) tauold
!
CLOSE( UNIT = iunupdate, STATUS = 'KEEP' )
!
END IF
!
! ... input values are restored at the end of each iteration ( they are
! ... modified by init_run )
!
starting_pot = startingpot
starting_wfc = startingwfc
!
ethr = diago_thr_init
!
CALL close_files()
CALL reset_k_points ( )
!
RETURN
!
END SUBROUTINE do_scf
!
END SUBROUTINE compute_scf

2
PW/move_ions.f90
View File

@ -277,7 +277,7 @@ SUBROUTINE move_ions()
WRITE( UNIT = stdout, FMT = 9120 )
!
CALL clean_pw( .FALSE. )
CALL close_files()
CALL close_files(.TRUE.)
lmovecell=.FALSE.
lcheck_cell=.FALSE.
final_cell_calculation=.FALSE.

4
PW/pwscf.f90
View File

@ -100,8 +100,6 @@ PROGRAM pwscf
IF ( .NOT. conv_elec ) THEN
CALL punch( 'all' )
CALL stop_run( conv_elec )
CALL environment_end( 'PWSCF' )
CALL mp_global_end()
ENDIF
!
! ... if requested ions are moved
@ -160,8 +158,6 @@ PROGRAM pwscf
!
CALL punch('all')
CALL stop_run( conv_ions )
CALL environment_end( 'PWSCF' )
CALL mp_global_end()
!
! END IF
!

30
PW/stop_run.f90
View File

@ -6,7 +6,7 @@
! or http://www.gnu.org/copyleft/gpl.txt .
!
!----------------------------------------------------------------------------
SUBROUTINE stop_run( flag )
SUBROUTINE stop_run( lflag )
!----------------------------------------------------------------------------
!
! ... Close all files and synchronize processes before stopping.
@ -29,16 +29,16 @@ SUBROUTINE stop_run( flag )
!
IMPLICIT NONE
!
LOGICAL, INTENT(IN) :: flag
LOGICAL :: exst, opnd, flag2
LOGICAL, INTENT(IN) :: lflag
LOGICAL :: exst, opnd, lflag2
!
!
#if defined (EXX)
flag2 = lpath .or. nimage > 1
lflag2 = lpath .or. nimage > 1
#else
flag2 = lpath
lflag2 = lpath
#endif
! IF ( flag2 ) THEN
! IF ( lflag2 ) THEN
!
! CALL io_image_stop()
!
@ -54,12 +54,12 @@ SUBROUTINE stop_run( flag )
! ... the execution - close the file and save it (or delete it
! ... if the wavefunctions are already stored in the .save file)
!
IF (flag .and. .not. flag2 ) THEN
IF (lflag .and. .not. lflag2 ) THEN
CALL seqopn( iuntmp, 'restart', 'UNFORMATTED', exst )
CLOSE( UNIT = iuntmp, STATUS = 'DELETE' )
ENDIF
IF ( flag .AND. ionode ) THEN
IF ( lflag .AND. ionode ) THEN
!
! ... all other files must be reopened and removed
!
@ -71,25 +71,19 @@ SUBROUTINE stop_run( flag )
!
END IF
!
CALL close_files(flag)
CALL close_files(lflag)
!
CALL print_clock_pw()
!
! CALL environment_end( 'PWSCF' )
CALL environment_end( 'PWSCF' )
!
! CALL mp_global_end ()
CALL mp_global_end ()
!
CALL clean_pw( .TRUE. )
!
CALL deallocate_bp_efield()
!
CALL deallocate_input_parameters ()
!
IF ( llondon ) CALL dealloca_london()
!
IF ( lconstrain ) CALL deallocate_constraint()
!
IF ( flag ) THEN
IF ( lflag ) THEN
!
STOP
!