Fixed some bugs in path_base. image-parallelisation of NEB and SMD modified in order

to be compatible with global filesystems exported via NFS (needed by N.Marzari's group).
NEB and SMD still require a global filesystem.
C.S.


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@1611 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
sbraccia 2005-02-01 16:59:22 +00:00
parent d9a0d67234
commit 5f87767056
3 changed files with 193 additions and 222 deletions

View File

@ -345,13 +345,11 @@ MODULE path_base
!
inter_image_dist = path_length / DBLE( num_of_images - 1 )
!
! FORALL( i = 1: ( input_images - 1 ) )
do i = 1, input_images - 1
DO i = 1, input_images - 1
!
d_R(:,i) = d_R(:,i) / image_spacing(i)
!
end do
! END FORALL
END DO
!
pos_(:,1) = pos(1:dim,1)
!
@ -470,7 +468,7 @@ MODULE path_base
!
! ... tangent to the path ( normalised )
!
tangent(:,i) = path_tangent( i )
tangent(:,i) = neb_tangent( i )
!
tangent(:,i) = tangent(:,i) / norm( tangent(:,i) )
!
@ -517,6 +515,78 @@ MODULE path_base
!
END SUBROUTINE neb_gradient
!
!-----------------------------------------------------------------------
FUNCTION neb_tangent( index )
!-----------------------------------------------------------------------
!
USE supercell, ONLY : pbc
USE path_variables, ONLY : pos, dim, num_of_modes, num_of_images, &
pes, path_length, path_length_av, ft_pos, &
ft_pos_av, pos_av_in, pos_av_fin, Nft, &
fixed_tan
!
IMPLICIT NONE
!
! ... I/O variables
!
INTEGER, INTENT(IN) :: index
REAL (KIND=DP) :: neb_tangent(dim)
!
! ... local variables
!
INTEGER :: n
REAL (KIND=DP) :: x, pi_n
REAL (KIND=DP) :: V_previous, V_actual, V_next
REAL (KIND=DP) :: abs_next, abs_previous
REAL (KIND=DP) :: delta_V_max, delta_V_min
!
!
! ... NEB definition of the tangent
!
V_previous = pes( index - 1 )
V_actual = pes( index )
V_next = pes( index + 1 )
!
IF ( ( V_next > V_actual ) .AND. ( V_actual > V_previous ) ) THEN
!
neb_tangent = pbc( pos(:,( index + 1 )) - pos(:,index) )
!
ELSE IF ( ( V_next < V_actual ) .AND. ( V_actual < V_previous ) ) THEN
!
neb_tangent = pbc( pos(:,index) - pos(:,( index - 1 )) )
!
ELSE
!
abs_next = ABS( V_next - V_actual )
abs_previous = ABS( V_previous - V_actual )
!
delta_V_max = MAX( abs_next , abs_previous )
delta_V_min = MIN( abs_next , abs_previous )
!
IF ( V_next > V_previous ) THEN
!
neb_tangent = &
pbc( pos(:,( index + 1 )) - pos(:,index) ) * delta_V_max + &
pbc( pos(:,index) - pos(:,( index - 1 )) ) * delta_V_min
!
ELSE IF ( V_next < V_previous ) THEN
!
neb_tangent = &
pbc( pos(:,( index + 1 )) - pos(:,index) ) * delta_V_min + &
pbc( pos(:,index) - pos(:,( index - 1 )) ) * delta_V_max
!
ELSE
!
neb_tangent = pbc( pos(:,( index + 1 )) - pos(:,( index - 1 )) )
!
END IF
!
END IF
!
RETURN
!
END FUNCTION neb_tangent
!
! ... smd specific routines
!
!-----------------------------------------------------------------------
@ -528,7 +598,7 @@ MODULE path_base
path_thr, Nft, ft_coeff, pos, pes, &
use_multistep, grad_pes, err_max, &
frozen, vel, vel_zeroed
USE io_global, ONLY : meta_ionode
!
IMPLICIT NONE
!
@ -551,9 +621,10 @@ MODULE path_base
!
! ... initialisation
!
WRITE( UNIT = iunpath, &
FMT = '(5X,"initial number of images = ",I3,/)' ) &
init_num_of_images
IF ( meta_ionode ) &
WRITE( UNIT = iunpath, &
& FMT = '(5X,"initial number of images = ",I3,/)' ) &
init_num_of_images
!
CALL redispose_last_image( init_num_of_images )
!
@ -567,9 +638,10 @@ MODULE path_base
!
IF ( new_num_of_images > num_of_images ) THEN
!
WRITE( UNIT = iunpath, &
FMT = '(5X,"new number of images = ",I3,/)' ) &
new_num_of_images
IF ( meta_ionode ) &
WRITE( UNIT = iunpath, &
& FMT = '(5X,"new number of images = ",I3,/)' ) &
new_num_of_images
!
CALL redispose_last_image( new_num_of_images )
!
@ -940,6 +1012,7 @@ MODULE path_base
!
USE path_variables, ONLY : num_of_images, grad, llangevin, &
first_last_opt, path_thr, error, frozen
USE mp_global, ONLY : nimage
!
IMPLICIT NONE
!
@ -950,8 +1023,8 @@ MODULE path_base
! ... local variables
!
INTEGER :: i, n
INTEGER :: N_in, N_fin
REAL (KIND=DP) :: err_max
INTEGER :: N_in, N_fin, free_me, num_of_scf_images
REAL (KIND=DP) :: err_max, val
!
!
IF ( first_last_opt ) THEN
@ -989,6 +1062,29 @@ MODULE path_base
!
END IF
!
IF ( nimage > 1 ) THEN
!
! ... in the case of image-parallelisation the number of images to
! ... be optimised must be larger than nimage
!
IF ( nimage > ( N_fin - N_in ) ) &
CALL errore( 'search_MEP', &
& 'nimage is larger than the number of images ', 1 )
!
find_scf_images: DO
!
num_of_scf_images = COUNT( .NOT. frozen )
!
IF ( num_of_scf_images >= nimage ) EXIT find_scf_images
!
free_me = MAXLOC( error, 1, frozen(N_in:N_fin) )
!
frozen(free_me) = .FALSE.
!
END DO find_scf_images
!
END IF
!
#endif
!
IF ( PRESENT( err_out ) ) err_out = err_max
@ -998,122 +1094,6 @@ MODULE path_base
END SUBROUTINE compute_error
!
!-----------------------------------------------------------------------
FUNCTION path_tangent( index )
!-----------------------------------------------------------------------
!
USE supercell, ONLY : pbc
USE control_flags, ONLY : lneb, lsmd
USE path_variables, ONLY : pos, dim, num_of_modes, num_of_images, &
pes, path_length, path_length_av, ft_pos, &
ft_pos_av, pos_av_in, pos_av_fin, Nft, &
fixed_tan
!
IMPLICIT NONE
!
! ... I/O variables
!
INTEGER, INTENT(IN) :: index
REAL (KIND=DP) :: path_tangent(dim)
!
! ... local variables
!
INTEGER :: n
REAL (KIND=DP) :: x, pi_n
REAL (KIND=DP) :: V_previous, V_actual, V_next
REAL (KIND=DP) :: abs_next, abs_previous
REAL (KIND=DP) :: delta_V_max, delta_V_min
!
!
IF ( lneb ) THEN
!
! ... NEB definition of the tangent
!
V_previous = pes( index - 1 )
V_actual = pes( index )
V_next = pes( index + 1 )
!
IF ( ( V_next > V_actual ) .AND. ( V_actual > V_previous ) ) THEN
!
path_tangent = pbc( pos(:,( index + 1 )) - pos(:,index) )
!
ELSE IF ( ( V_next < V_actual ) .AND. ( V_actual < V_previous ) ) THEN
!
path_tangent = pbc( pos(:,index) - pos(:,( index - 1 )) )
!
ELSE
!
abs_next = ABS( V_next - V_actual )
abs_previous = ABS( V_previous - V_actual )
!
delta_V_max = MAX( abs_next , abs_previous )
delta_V_min = MIN( abs_next , abs_previous )
!
IF ( V_next > V_previous ) THEN
!
path_tangent = &
pbc( pos(:,( index + 1 )) - pos(:,index) ) * delta_V_max + &
pbc( pos(:,index) - pos(:,( index - 1 )) ) * delta_V_min
!
ELSE IF ( V_next < V_previous ) THEN
!
path_tangent = &
pbc( pos(:,( index + 1 )) - pos(:,index) ) * delta_V_min + &
pbc( pos(:,index) - pos(:,( index - 1 )) ) * delta_V_max
!
ELSE
!
path_tangent = &
pbc( pos(:,( index + 1 )) - pos(:,( index - 1 )) )
!
END IF
!
END IF
!
ELSE IF ( lsmd ) THEN
!
! ... tangent from fourier interpolation
!
x = DBLE( index - 1 ) / DBLE( Nft )
!
IF ( fixed_tan ) THEN
!
path_tangent(:) = ( pos_av_fin(:) - pos_av_in(:) )
!
DO n = 1, num_of_modes
!
pi_n = pi * DBLE( n )
!
path_tangent(:) = path_tangent(:) + &
ft_pos_av(:,n) * pi_n * COS( pi_n * x )
!
END DO
!
path_tangent(:) = path_tangent(:) / path_length_av
!
ELSE
!
path_tangent(:) = ( pos(:,num_of_images) - pos(:,1) )
!
DO n = 1, num_of_modes
!
pi_n = pi * DBLE( n )
!
path_tangent(:) = path_tangent(:) + &
ft_pos(:,n) * pi_n * COS( pi_n * x )
!
END DO
!
path_tangent(:) = path_tangent(:) / path_length
!
END IF
!
END IF
!
RETURN
!
END FUNCTION path_tangent
!
!-----------------------------------------------------------------------
FUNCTION gaussian_vect()
!-----------------------------------------------------------------------
!
@ -1165,7 +1145,6 @@ MODULE path_base
istep_path, pes, first_last_opt, &
Emin , Emax, Emax_index, frozen, &
error
USE mp_global, ONLY : nimage
!
IMPLICIT NONE
!
@ -1175,24 +1154,14 @@ MODULE path_base
!
! ... local variables
!
INTEGER :: N_in, N_fin, i, free_me, num_of_scf_images
REAL (KIND=DP) :: val
INTEGER :: N_in, N_fin, i
!
!
IF ( istep_path == 0 ) THEN
IF ( istep_path == 0 .OR. first_last_opt ) THEN
!
N_in = 1
N_fin = num_of_images
!
ELSE IF ( first_last_opt ) THEN
!
N_in = 1
N_fin = num_of_images
!
IF ( frozen(1) ) N_in = 2
!
IF ( frozen(num_of_images) ) N_fin = ( num_of_images - 1 )
!
ELSE
!
N_in = 2
@ -1202,25 +1171,6 @@ MODULE path_base
!
IF ( suspended_image /= 0 ) N_in = suspended_image
!
IF ( nimage > 1 ) THEN
!
! ... in the case of image-parallelisation the number of images to
! ... be optimised must be larger than nimage
!
find_scf_images: DO
!
num_of_scf_images = COUNT( .NOT. frozen )
!
IF ( num_of_scf_images > nimage ) EXIT find_scf_images
!
free_me = MAXLOC( error, 1, frozen )
!
frozen(free_me) = .FALSE.
!
END DO find_scf_images
!
END IF
!
CALL compute_scf( N_in, N_fin, stat )
!
IF ( .NOT. stat ) RETURN
@ -1513,7 +1463,7 @@ MODULE path_base
!
USE input_parameters, ONLY : num_of_images_inp => num_of_images
USE control_flags, ONLY : lneb, lsmd
USE io_global, ONLY : ionode
USE io_global, ONLY : meta_ionode
USE path_variables, ONLY : path_thr, istep_path, nstep_path, &
conv_path, suspended_image, &
num_of_images, llangevin, lmol_dyn
@ -1537,16 +1487,20 @@ MODULE path_base
!
IF ( exit_condition ) THEN
!
WRITE( UNIT = iunpath, FMT = final_fmt )
!
IF ( ionode .AND. lneb ) &
WRITE( UNIT = iunpath, &
FMT = '(/,5X,"neb: convergence achieved in ",I3, &
& " iterations" )' ) istep_path
IF ( ionode .AND. lsmd ) &
WRITE( UNIT = iunpath, &
FMT = '(/,5X,"smd: convergence achieved in ",I3, &
& " iterations" )' ) istep_path
IF ( meta_ionode ) THEN
!
WRITE( UNIT = iunpath, FMT = final_fmt )
!
IF ( lneb ) &
WRITE( UNIT = iunpath, &
FMT = '(/,5X,"neb: convergence achieved in ",I3, &
& " iterations" )' ) istep_path
IF ( lsmd ) &
WRITE( UNIT = iunpath, &
FMT = '(/,5X,"smd: convergence achieved in ",I3, &
& " iterations" )' ) istep_path
!
END IF
!
suspended_image = 0
!
@ -1563,16 +1517,20 @@ MODULE path_base
!
IF ( istep_path >= nstep_path ) THEN
!
WRITE( UNIT = iunpath, FMT = final_fmt )
!
IF ( ionode .AND. lneb ) &
WRITE( UNIT = iunpath, &
FMT = '(/,5X,"neb: reached the maximum number of ", &
& "steps")' )
IF ( ionode .AND. lsmd ) &
WRITE( UNIT = iunpath, &
FMT = '(/,5X,"smd: reached the maximum number of ", &
& "steps")' )
IF ( meta_ionode ) THEN
!
WRITE( UNIT = iunpath, FMT = final_fmt )
!
IF ( lneb ) &
WRITE( UNIT = iunpath, &
FMT = '(/,5X,"neb: reached the maximum number of ", &
& "steps")' )
IF ( lsmd ) &
WRITE( UNIT = iunpath, &
FMT = '(/,5X,"smd: reached the maximum number of ", &
& "steps")' )
!
END IF
!
suspended_image = 0
!

View File

@ -58,6 +58,9 @@ MODULE path_variables
lmol_dyn = .FALSE., &! .TRUE. if opt_scheme = "mol-dyn"
lbroyden = .FALSE., &! .TRUE. if opt_scheme = "broyden"
llangevin = .FALSE. ! .TRUE. if opt_scheme = "langevin"
LOGICAL :: &
tune_load_balance ! if .TRUE. the load balance for image
! parallelisation is tuned at runtime
INTEGER :: &
istep_path, &! iteration in the optimization procedure
nstep_path, &! maximum number of iterations

View File

@ -40,6 +40,7 @@ SUBROUTINE compute_scf( N_in, N_fin, stat )
dim, suspended_image, istep_path, &
first_last_opt, frozen, write_save
USE parser, ONLY : int_to_char
USE path_variables, ONLY : tune_load_balance
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
@ -61,14 +62,10 @@ SUBROUTINE compute_scf( N_in, N_fin, stat )
REAL(KIND=DP), ALLOCATABLE :: tauold(:,:,:)
! previous positions of atoms (needed for extrapolation)
!
! ... end of local variables definition
!
! ... external functions definition
!
REAL (KIND=DP), EXTERNAL :: get_clock
!
! ... end of external functions definition
!
tune_load_balance = .FALSE.
!
istep = istep_path + 1
istat = 0
@ -101,7 +98,7 @@ SUBROUTINE compute_scf( N_in, N_fin, stat )
! ... only the first cpu initializes the file needed by parallelization
! ... among images
!
IF ( ( nimage > 1 ) .AND. meta_ionode ) CALL new_image_init()
IF ( meta_ionode ) CALL new_image_init()
!
image = N_in + my_image_id
!
@ -130,7 +127,7 @@ SUBROUTINE compute_scf( N_in, N_fin, stat )
!
END IF
!
! ... self-consistency ( for non-frozen images only, in neb case )
! ... self-consistency ( for non-frozen images only )
!
IF ( .NOT. frozen(image) ) THEN
!
@ -384,11 +381,12 @@ SUBROUTINE compute_scf( N_in, N_fin, stat )
! ... this subroutine initializes the file needed for the
! ... parallelization among images
!
USE io_files, ONLY : iunnewimage
USE mp_global, ONLY : nimage
USE io_files, ONLY : iunnewimage
USE path_variables, ONLY : tune_load_balance
!
IMPLICIT NONE
!
IF ( nimage == 1 .OR. .NOT. tune_load_balance ) RETURN
!
OPEN( UNIT = iunnewimage, FILE = TRIM( tmp_dir_saved ) // &
& TRIM( prefix ) // '.newimage' , STATUS = 'UNKNOWN' )
@ -409,13 +407,15 @@ SUBROUTINE compute_scf( N_in, N_fin, stat )
! ... the "prefix.BLOCK" file is needed to avoid (when present) that
! ... other jobs try to read/write on file "prefix.newimage"
!
USE io_files, ONLY : iunnewimage, iunblock
USE io_global, ONLY : ionode
USE io_files, ONLY : iunnewimage, iunblock
USE io_global, ONLY : ionode
USE path_variables, ONLY : tune_load_balance
!
IMPLICIT NONE
!
INTEGER, INTENT(INOUT) :: image
INTEGER :: ioerr
CHARACTER (LEN=256) :: filename
LOGICAL :: opened, exists
!
!
@ -423,38 +423,48 @@ SUBROUTINE compute_scf( N_in, N_fin, stat )
!
IF ( nimage > 1 ) THEN
!
open_loop: DO
!
OPEN( UNIT = iunblock, FILE = TRIM( tmp_dir_saved ) // &
& TRIM( prefix ) // '.BLOCK' , IOSTAT = ioerr, STATUS = 'NEW' )
IF ( tune_load_balance ) THEN
!
IF ( ioerr > 0 ) CYCLE open_loop
filename = TRIM( tmp_dir_saved ) // TRIM( prefix ) // '.BLOCK'
!
INQUIRE( UNIT = iunnewimage, OPENED = opened )
open_loop: DO
!
OPEN( UNIT = iunblock, FILE = TRIM( filename ), &
& IOSTAT = ioerr, STATUS = 'NEW' )
!
IF ( ioerr > 0 ) CYCLE open_loop
!
INQUIRE( UNIT = iunnewimage, OPENED = opened )
!
IF ( .NOT. opened ) THEN
!
OPEN( UNIT = iunnewimage, FILE = TRIM( tmp_dir_saved ) // &
& TRIM( prefix ) // '.newimage' , STATUS = 'OLD' )
!
READ( iunnewimage, * ) image
!
CLOSE( UNIT = iunnewimage, STATUS = 'DELETE' )
!
OPEN( UNIT = iunnewimage, FILE = TRIM( tmp_dir_saved ) // &
& TRIM( prefix ) // '.newimage' , STATUS = 'NEW' )
!
WRITE( iunnewimage, * ) image + 1
!
CLOSE( UNIT = iunnewimage, STATUS = 'KEEP' )
!
EXIT open_loop
!
END IF
!
END DO open_loop
!
IF ( .NOT. opened ) THEN
!
OPEN( UNIT = iunnewimage, FILE = TRIM( tmp_dir_saved ) // &
& TRIM( prefix ) // '.newimage' , STATUS = 'OLD' )
!
READ( iunnewimage, * ) image
!
CLOSE( UNIT = iunnewimage, STATUS = 'DELETE' )
!
OPEN( UNIT = iunnewimage, FILE = TRIM( tmp_dir_saved ) // &
& TRIM( prefix ) // '.newimage' , STATUS = 'NEW' )
!
WRITE( iunnewimage, * ) image + 1
!
CLOSE( UNIT = iunnewimage, STATUS = 'KEEP' )
!
EXIT open_loop
!
END IF
CLOSE( UNIT = iunblock, STATUS = 'DELETE' )
!
END DO open_loop
!
CLOSE( UNIT = iunblock, STATUS = 'DELETE' )
ELSE
!
image = image + nimage
!
END IF
!
ELSE
!