mirror of https://gitlab.com/QEF/q-e.git
- General cleanup.
- NEB: 1) units for activation energy and errors are printed in the output file
2) elastic constants are automatically rescaled so that "spring"-forces have the
same magnitude as "external-potential"-forces: this permits a larger time step
in NEB optimizations (the default will be changed later)
3) fixed a bug in the way istep and istep_neb were set
- parser: the subroutine delete_if_present has a logical optional input argument to require a
warning message when a file is removed
- check_stop: the function check_stop_now has an option input argument to assign an output unit
different from stdout
C.S.
git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@753 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
sbraccia
parent
18a9b037c0
commit
28bfb48b47
|
|
@ -47,7 +47,7 @@ MODULE check_stop
|
|||
!
|
||||
IF( tinit ) &
|
||||
WRITE( UNIT = stdout, &
|
||||
FMT = '("WARNING: check_stop already initialized *** ")' )
|
||||
FMT = '(/,5X,"WARNING: check_stop already initialized")' )
|
||||
!
|
||||
IF ( val > 0.D0 ) max_seconds = val
|
||||
!
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
!
|
||||
! Copyright (C) 2001-2003 PWSCF group
|
||||
! Copyright (C) 2003-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,
|
||||
|
|
@ -10,6 +10,8 @@
|
|||
MODULE formats
|
||||
!---------------------------------------------------------------------------
|
||||
!
|
||||
! ... this module contains the I/O formats used by all NEB-routines
|
||||
!
|
||||
CHARACTER (LEN=*), PARAMETER :: &
|
||||
lattice_vectors = "(3(2X,F14.10),/,3(2X,F14.10),/,3(2X,F14.10))"
|
||||
!
|
||||
|
|
@ -32,12 +34,12 @@ MODULE formats
|
|||
& "'; self-consistency for image ', I3)", &
|
||||
scf_fmt_para = "(5X,'cpu = ',I2,'; tcpu = ',F8.2," // &
|
||||
& "'; self-consistency for image ', I3)", &
|
||||
run_output = "(/,5X,'iteration: ',I3,5X,'E activation ='," // &
|
||||
& " F10.6,5X,'error =',F10.6,/)", &
|
||||
run_output_T_const = "(/,5X,'iteration: ',I3,5X,'temperature ='," // &
|
||||
& " F10.2,5X,'forces =',F10.6)", &
|
||||
final_output = "(5X,'image: ',I2,' Energy = ',F16.8," // &
|
||||
& "' Error = ',F8.5)"
|
||||
run_output = "(/,5X,'iteration:',I4,4X,'E activation ='," // &
|
||||
& " F6.3,' eV',4X,'error =',F8.4,' eV / bohr'/)", &
|
||||
run_output_T_const = "(/,5X,'iteration:',I4,4X,'temperature ='," // &
|
||||
& " F8.2,' K',4X,'forces =',F8.4,' eV / bohr')", &
|
||||
final_output = "(5X,'image: ',I2,' E tot = ',F16.8," // &
|
||||
& "' eV error = ',F8.4,' eV / bohr')"
|
||||
!
|
||||
CHARACTER (LEN=*), PARAMETER :: &
|
||||
stringfmt = "(5X,A,T35,' = ',A)"
|
||||
|
|
|
|||
|
|
@ -86,7 +86,7 @@
|
|||
!
|
||||
INTEGER :: iunexit = 26 ! unit for a soft exit
|
||||
INTEGER :: iunupdate = 27 ! unit for saving old positions (extrapolation)
|
||||
INTEGER :: iunpara = 28 ! unit for parallelization among images
|
||||
INTEGER :: iunnewimage = 28 ! unit for parallelization among images
|
||||
INTEGER :: iunblock = 29 ! as above (blocking file)
|
||||
!
|
||||
! ... NEB specific
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
!
|
||||
! Copyright (C) 2001-2004 PWSCF group
|
||||
! Copyright (C) 2003-2004 PWSCF-FPMD-CPV 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,
|
||||
|
|
@ -169,6 +169,8 @@ MODULE neb_base
|
|||
END IF
|
||||
!
|
||||
ELSE
|
||||
!
|
||||
! ... linear interpolation
|
||||
!
|
||||
ALLOCATE( d_R(dim) )
|
||||
!
|
||||
|
|
@ -186,6 +188,8 @@ MODULE neb_base
|
|||
!
|
||||
END IF
|
||||
!
|
||||
! ... the actual number of degrees of freedom is computed
|
||||
!
|
||||
CALL compute_deg_of_freedom()
|
||||
!
|
||||
! ... details of the calculation are written on output (only by ionode)
|
||||
|
|
@ -222,7 +226,7 @@ MODULE neb_base
|
|||
!
|
||||
CONTAINS
|
||||
!
|
||||
SUBROUTINE compute_deg_of_freedom
|
||||
SUBROUTINE compute_deg_of_freedom()
|
||||
!
|
||||
USE ions_base, ONLY : nat
|
||||
USE input_parameters, ONLY : if_pos
|
||||
|
|
@ -230,7 +234,7 @@ MODULE neb_base
|
|||
!
|
||||
IMPLICIT NONE
|
||||
!
|
||||
INTEGER :: ia
|
||||
INTEGER :: ia
|
||||
!
|
||||
!
|
||||
deg_of_freedom = 0
|
||||
|
|
@ -249,43 +253,6 @@ MODULE neb_base
|
|||
!
|
||||
!
|
||||
!------------------------------------------------------------------------
|
||||
SUBROUTINE compute_action( langevin_action )
|
||||
!------------------------------------------------------------------------
|
||||
!
|
||||
USE neb_variables, ONLY : num_of_images, pos, PES_gradient
|
||||
USE basic_algebra_routines, ONLY : norm
|
||||
!
|
||||
IMPLICIT NONE
|
||||
!
|
||||
! ... I/O variables
|
||||
!
|
||||
REAL (KIND=DP), INTENT(OUT) :: langevin_action(:)
|
||||
!
|
||||
! ... local variables
|
||||
!
|
||||
INTEGER :: image
|
||||
!
|
||||
! ... end of local variables
|
||||
!
|
||||
!
|
||||
langevin_action = 0.D0
|
||||
!
|
||||
DO image = 2, ( num_of_images - 1 )
|
||||
!
|
||||
!langevin_action(image) = norm( pos(:,(image+1)) - pos(:,image) ) * &
|
||||
! ( norm( PES_gradient(:,image+1) ) + &
|
||||
! norm( PES_gradient(:,image) ) )
|
||||
langevin_action(image) = &
|
||||
0.5D0 * ( norm( pos(:,image+1) - pos(:,image) ) + &
|
||||
norm( pos(:,image) - pos(:,image-1) ) ) * &
|
||||
( norm( PES_gradient(:,image+1) ) + norm( PES_gradient(:,image-1) ) )
|
||||
!
|
||||
END DO
|
||||
!
|
||||
END SUBROUTINE compute_action
|
||||
!
|
||||
!
|
||||
!------------------------------------------------------------------------
|
||||
SUBROUTINE compute_tangent()
|
||||
!------------------------------------------------------------------------
|
||||
!
|
||||
|
|
@ -325,16 +292,19 @@ MODULE neb_base
|
|||
!------------------------------------------------------------------------
|
||||
!
|
||||
USE constants, ONLY : pi, eps32
|
||||
USE neb_variables, ONLY : num_of_images, Emax, Emin, &
|
||||
USE neb_variables, ONLY : pos, num_of_images, Emax, Emin, &
|
||||
k_max, k_min, k, PES, PES_gradient, &
|
||||
VEC_scheme
|
||||
USE basic_algebra_routines, ONLY : norm
|
||||
VEC_scheme, elastic_gradient, tangent
|
||||
USE supercell, ONLY : pbc
|
||||
USE basic_algebra_routines
|
||||
!
|
||||
IMPLICIT NONE
|
||||
!
|
||||
! ... local variables
|
||||
!
|
||||
INTEGER :: image
|
||||
INTEGER :: i
|
||||
REAL (KIND=DP) :: F_ortho_max, F_ortho_max_i, &
|
||||
F_para_max_i, F_para_max
|
||||
REAL (KIND=DP) :: delta_E
|
||||
REAL (KIND=DP) :: norm_grad_V, norm_grad_V_min, norm_grad_V_max
|
||||
!
|
||||
|
|
@ -353,10 +323,10 @@ MODULE neb_base
|
|||
!
|
||||
END IF
|
||||
!
|
||||
DO image = 1, num_of_images
|
||||
DO i = 1, num_of_images
|
||||
!
|
||||
k(image) = 0.25D0 * ( ( k_max + k_min ) - ( k_max - k_min ) * &
|
||||
COS( pi * ( PES(image) - Emin ) / delta_E ) )
|
||||
k(i) = 0.25D0 * ( ( k_max + k_min ) - ( k_max - k_min ) * &
|
||||
COS( pi * ( PES(i) - Emin ) / delta_E ) )
|
||||
!
|
||||
END DO
|
||||
!
|
||||
|
|
@ -365,27 +335,55 @@ MODULE neb_base
|
|||
norm_grad_V_min = + 1.0D32
|
||||
norm_grad_V_max = - 1.0D32
|
||||
!
|
||||
DO image = 1, num_of_images
|
||||
DO i = 1, num_of_images
|
||||
!
|
||||
norm_grad_V = norm( PES_gradient(:,image) )
|
||||
norm_grad_V = norm( PES_gradient(:,i) )
|
||||
!
|
||||
IF ( norm_grad_V < norm_grad_V_min ) norm_grad_V_min = norm_grad_V
|
||||
IF ( norm_grad_V > norm_grad_V_max ) norm_grad_V_max = norm_grad_V
|
||||
!
|
||||
END DO
|
||||
!
|
||||
DO image = 1, num_of_images
|
||||
DO i = 1, num_of_images
|
||||
!
|
||||
norm_grad_V = norm( PES_gradient(:,image) )
|
||||
norm_grad_V = norm( PES_gradient(:,i) )
|
||||
!
|
||||
k(image) = 0.25D0 * ( ( k_max + k_min ) - ( k_max - k_min ) * &
|
||||
COS( pi * ( norm_grad_V - norm_grad_V_min ) / &
|
||||
( norm_grad_V_max - norm_grad_V_min ) ) )
|
||||
k(i) = 0.25D0 * ( ( k_max + k_min ) - ( k_max - k_min ) * &
|
||||
COS( pi * ( norm_grad_V - norm_grad_V_min ) / &
|
||||
( norm_grad_V_max - norm_grad_V_min ) ) )
|
||||
!
|
||||
END DO
|
||||
!
|
||||
END IF
|
||||
!
|
||||
F_ortho_max = 0.D0
|
||||
F_para_max = 0.D0
|
||||
!
|
||||
DO i = 2, ( num_of_images - 1 )
|
||||
!
|
||||
F_ortho_max_i = MAXVAL( ABS( PES_gradient(:,i) - tangent(:,i) * &
|
||||
( PES_gradient(:,i) .dot. tangent(:,i) ) ) )
|
||||
!
|
||||
elastic_gradient = tangent(:,i) * &
|
||||
( ( k(i) + k(i-1) ) * norm( pbc( pos(:,i) - pos(:,(i-1)) ) ) - &
|
||||
( k(i) + k(i+1) ) * norm( pbc( pos(:,(i+1)) - pos(:,i) ) ) )
|
||||
!
|
||||
F_para_max_i = MAXVAL( ABS( elastic_gradient(:) ) )
|
||||
!
|
||||
IF ( F_ortho_max_i > F_ortho_max ) F_ortho_max = F_ortho_max_i
|
||||
!
|
||||
IF ( F_para_max_i > F_para_max ) F_para_max = F_para_max_i
|
||||
!
|
||||
END DO
|
||||
!
|
||||
PRINT '(/5X,"F_ortho_max = ",F10.6)', F_ortho_max
|
||||
PRINT '(5X,"F_para_max = ",F10.6)', F_para_max
|
||||
PRINT '(5X,"ALPHA = ",F10.6)', F_ortho_max / F_para_max
|
||||
!
|
||||
k = k * F_ortho_max / F_para_max
|
||||
k_max = k_max * F_ortho_max / F_para_max
|
||||
k_min = k_min * F_ortho_max / F_para_max
|
||||
!
|
||||
RETURN
|
||||
!
|
||||
END SUBROUTINE elastic_constants
|
||||
|
|
@ -400,7 +398,7 @@ MODULE neb_base
|
|||
elastic_gradient, PES_gradient, k, &
|
||||
num_of_images, free_minimization, &
|
||||
climbing, tangent, lmol_dyn
|
||||
USE basic_algebra_routines, ONLY : norm
|
||||
USE basic_algebra_routines
|
||||
!
|
||||
IMPLICIT NONE
|
||||
!
|
||||
|
|
@ -410,7 +408,8 @@ MODULE neb_base
|
|||
!
|
||||
! ... end of local variables
|
||||
!
|
||||
CALL elastic_constants
|
||||
!
|
||||
CALL elastic_constants()
|
||||
!
|
||||
gradient_loop: DO i = 1, num_of_images
|
||||
!
|
||||
|
|
@ -447,13 +446,13 @@ MODULE neb_base
|
|||
IF ( climbing(i) ) THEN
|
||||
!
|
||||
grad(:,i) = grad(:,i) - 2.D0 * tangent(:,i) * &
|
||||
DOT_PRODUCT( PES_gradient(:,i) , tangent(:,i) )
|
||||
( PES_gradient(:,i) .dot. tangent(:,i) )
|
||||
!
|
||||
ELSE IF ( ( .NOT. free_minimization(i) ) .AND. &
|
||||
( i > 1 ) .AND. ( i < num_of_images ) ) THEN
|
||||
!
|
||||
grad(:,i) = grad(:,i) + elastic_gradient - tangent(:,i) * &
|
||||
DOT_PRODUCT( PES_gradient(:,i) , tangent(:,i) )
|
||||
grad(:,i) = elastic_gradient + PES_gradient(:,i) - &
|
||||
tangent(:,i) * ( PES_gradient(:,i) .dot. tangent(:,i) )
|
||||
!
|
||||
END IF
|
||||
!
|
||||
|
|
@ -896,7 +895,7 @@ MODULE neb_base
|
|||
IF ( ionode ) &
|
||||
WRITE( UNIT = iunneb, &
|
||||
FMT = '(/,5X,"NEB: convergence achieved in ",I3, &
|
||||
& " iterations" )' )
|
||||
& " iterations" )' ) istep_neb
|
||||
!
|
||||
conv_neb = .TRUE.
|
||||
!
|
||||
|
|
|
|||
|
|
@ -5,11 +5,30 @@
|
|||
! in the root directory of the present distribution,
|
||||
! or http://www.gnu.org/copyleft/gpl.txt .
|
||||
!
|
||||
!
|
||||
! ... SUBROUTINE con_cam: counts the number of fields in a string
|
||||
! separated by the optional character
|
||||
!
|
||||
! ... SUBROUTINE field_count: accepts two string (one of them is optional)
|
||||
! and one integer and count the number of fields
|
||||
! in the string separated by a blank or a tab
|
||||
! character. If the optional string is specified
|
||||
! (it has anyway len=1) it is assumed as the
|
||||
! separator character.
|
||||
! Ignores any charcter following the exclamation
|
||||
! mark (fortran comment)
|
||||
!
|
||||
! ... SUBROUTINE field_compare: accepts two strings and one integer. Counts the
|
||||
! fields contained in the first string and
|
||||
! compares it with the integer.
|
||||
! If they are less than the integer calls the
|
||||
! routine error and show by the second string the
|
||||
! name of the field where read-error occurred.
|
||||
!----------------------------------------------------------------------------
|
||||
MODULE parser
|
||||
!----------------------------------------------------------------------------
|
||||
!
|
||||
USE io_global, ONLY : stdout
|
||||
USE io_global, ONLY : stdout
|
||||
USE kinds
|
||||
!
|
||||
CONTAINS
|
||||
|
|
@ -52,14 +71,15 @@ MODULE parser
|
|||
!
|
||||
!
|
||||
!--------------------------------------------------------------------------
|
||||
SUBROUTINE delete_if_present( filename )
|
||||
SUBROUTINE delete_if_present( filename, in_warning )
|
||||
!--------------------------------------------------------------------------
|
||||
!
|
||||
IMPLICIT NONE
|
||||
!
|
||||
CHARACTER(LEN=*) :: filename
|
||||
LOGICAL :: exst, opnd
|
||||
INTEGER :: iunit
|
||||
CHARACTER(LEN=*), INTENT(IN) :: filename
|
||||
LOGICAL, OPTIONAL, INTENT(IN) :: in_warning
|
||||
LOGICAL :: exst, opnd, warning
|
||||
INTEGER :: iunit
|
||||
!
|
||||
INQUIRE( FILE = filename, EXIST = exst )
|
||||
!
|
||||
|
|
@ -70,11 +90,17 @@ MODULE parser
|
|||
INQUIRE( UNIT = iunit, OPENED = opnd )
|
||||
!
|
||||
IF ( .NOT. opnd ) THEN
|
||||
!
|
||||
warning = .FALSE.
|
||||
!
|
||||
IF ( PRESENT( in_warning ) ) warning = in_warning
|
||||
!
|
||||
OPEN( UNIT = iunit, FILE = filename , STATUS = 'OLD' )
|
||||
CLOSE( UNIT = iunit, STATUS = 'DELETE' )
|
||||
WRITE( UNIT = stdout, &
|
||||
FMT = '(/,5X,"WARNING: ",A," file was present; old file deleted")' ) filename
|
||||
!
|
||||
IF ( warning ) &
|
||||
WRITE( UNIT = stdout, FMT = '(/,5X"WARNING: ",A, &
|
||||
& " file was present; old file deleted")' ) filename
|
||||
!
|
||||
RETURN
|
||||
!
|
||||
|
|
@ -92,172 +118,214 @@ MODULE parser
|
|||
!
|
||||
!
|
||||
!-----------------------------------------------------------------------
|
||||
logical function matches (string1, string2)
|
||||
PURE FUNCTION matches( string1, string2 )
|
||||
!-----------------------------------------------------------------------
|
||||
!
|
||||
! .true. if string 1 is contained in string2, .false. otherwise
|
||||
! ... .TRUE. if string 1 is contained in string2, .FALSE. otherwise
|
||||
!
|
||||
implicit none
|
||||
character (len=*) :: string1, string2
|
||||
integer :: len1, len2, l
|
||||
|
||||
|
||||
len1 = len_trim(string1)
|
||||
len2 = len_trim(string2)
|
||||
do l = 1, len2 - len1 + 1
|
||||
if (string1 (1:len1) .eq.string2 (l:l + len1 - 1) ) then
|
||||
matches = .true.
|
||||
return
|
||||
endif
|
||||
enddo
|
||||
|
||||
matches = .false.
|
||||
return
|
||||
end function matches
|
||||
IMPLICIT NONE
|
||||
!
|
||||
CHARACTER (LEN=*), INTENT(IN) :: string1, string2
|
||||
LOGICAL :: matches
|
||||
INTEGER :: len1, len2, l
|
||||
!
|
||||
!
|
||||
len1 = LEN_TRIM( string1 )
|
||||
len2 = LEN_TRIM( string2 )
|
||||
!
|
||||
DO l = 1, ( len2 - len1 + 1 )
|
||||
!
|
||||
IF ( string1(1:len1) == string2(l:(l+len1-1)) ) THEN
|
||||
!
|
||||
matches = .TRUE.
|
||||
!
|
||||
RETURN
|
||||
!
|
||||
END IF
|
||||
!
|
||||
END DO
|
||||
!
|
||||
matches = .FALSE.
|
||||
!
|
||||
RETURN
|
||||
!
|
||||
END FUNCTION matches
|
||||
!
|
||||
!
|
||||
!-----------------------------------------------------------------------
|
||||
function capital (character)
|
||||
PURE FUNCTION capital( in_char )
|
||||
!-----------------------------------------------------------------------
|
||||
!
|
||||
! converts character to capital if lowercase
|
||||
! copy character to output in all other cases
|
||||
! ... converts character to capital if lowercase
|
||||
! ... copy character to output in all other cases
|
||||
!
|
||||
implicit none
|
||||
character (len=1) :: capital, character
|
||||
IMPLICIT NONE
|
||||
!
|
||||
character(len=26) :: minuscole='abcdefghijklmnopqrstuvwxyz', &
|
||||
maiuscole='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
|
||||
integer :: i
|
||||
CHARACTER(LEN=1), INTENT(IN) :: in_char
|
||||
CHARACTER(LEN=1) :: capital
|
||||
CHARACTER(LEN=26) :: lower = 'abcdefghijklmnopqrstuvwxyz', &
|
||||
upper = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
|
||||
INTEGER :: i
|
||||
!
|
||||
do i=1,26
|
||||
if (character.eq.minuscole(i:i)) then
|
||||
capital=maiuscole(i:i)
|
||||
return
|
||||
end if
|
||||
end do
|
||||
capital = character
|
||||
!
|
||||
return
|
||||
end function capital
|
||||
|
||||
SUBROUTINE field_count(num, line, car)
|
||||
CHARACTER(LEN=*) :: line
|
||||
CHARACTER(LEN=1) :: sep1, sep2
|
||||
CHARACTER(LEN=1), OPTIONAL :: car
|
||||
INTEGER :: num, j
|
||||
|
||||
num = 0
|
||||
IF ( .NOT. present(car) ) THEN
|
||||
|
||||
sep1=char(32) !blank character
|
||||
sep2=char(9) !tab character
|
||||
DO j=2, MAX(len(line),256)
|
||||
IF ( line(j:j) == '!' .OR. line(j:j) == char(0)) THEN
|
||||
IF ( (line(j-1:j-1) .NE. sep1) .AND. &
|
||||
(line(j-1:j-1) .NE. sep2) ) THEN
|
||||
num = num + 1
|
||||
END IF
|
||||
EXIT
|
||||
END IF
|
||||
IF ( ( (line(j:j) .EQ. sep1) .OR. &
|
||||
(line(j:j) .EQ. sep2) ) .AND. &
|
||||
( (line(j-1:j-1) .NE. sep1) .AND. &
|
||||
(line(j-1:j-1) .NE. sep2) ) ) THEN
|
||||
num = num + 1
|
||||
END IF
|
||||
END DO
|
||||
ELSE
|
||||
sep1=car
|
||||
DO j=2, MAX(len(line),256)
|
||||
IF ( line(j:j) == '!' .OR. line(j:j) == char(0) .OR. &
|
||||
line(j:j) == char(32)) THEN
|
||||
IF( line(j-1:j-1) .NE. sep1 ) THEN
|
||||
num = num + 1
|
||||
END IF
|
||||
EXIT
|
||||
END IF
|
||||
IF ( (line(j:j) .EQ. sep1) .AND. &
|
||||
(line(j-1:j-1) .NE. sep1) ) THEN
|
||||
num = num + 1
|
||||
END IF
|
||||
END DO
|
||||
END IF
|
||||
|
||||
RETURN
|
||||
|
||||
END SUBROUTINE field_count
|
||||
|
||||
|
||||
SUBROUTINE read_line( line, nfield, field, end_of_file )
|
||||
USE mp, ONLY: mp_bcast
|
||||
USE mp_global, ONLY: group
|
||||
USE io_global, ONLY: ionode, ionode_id
|
||||
CHARACTER(LEN=*), INTENT(OUT) :: line
|
||||
CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: field
|
||||
INTEGER, OPTIONAL, INTENT(IN) :: nfield
|
||||
LOGICAL, OPTIONAL, INTENT(OUT) :: end_of_file
|
||||
LOGICAL :: tend
|
||||
|
||||
IF( LEN( line ) < 256 ) THEN
|
||||
CALL errore(' read_line ', ' input line too short ', LEN( line ) )
|
||||
END IF
|
||||
|
||||
IF ( ionode ) THEN
|
||||
READ (5, fmt='(A256)', END=10) line
|
||||
tend = .FALSE.
|
||||
GO TO 20
|
||||
10 tend = .TRUE.
|
||||
20 CONTINUE
|
||||
END IF
|
||||
CALL mp_bcast(tend, ionode_id, group)
|
||||
CALL mp_bcast(line, ionode_id, group)
|
||||
|
||||
IF( PRESENT(end_of_file) ) THEN
|
||||
end_of_file = tend
|
||||
ELSE IF( tend ) THEN
|
||||
CALL errore(' read_line ', ' end of file ', 0 )
|
||||
ELSE
|
||||
IF( PRESENT(field) ) CALL field_compare(line, nfield, field)
|
||||
END IF
|
||||
|
||||
DO i=1, 26
|
||||
!
|
||||
IF ( in_char == lower(i:i) ) THEN
|
||||
!
|
||||
capital = upper(i:i)
|
||||
!
|
||||
RETURN
|
||||
END SUBROUTINE
|
||||
|
||||
!SUBROUTINE con_cam: count the number of fields in a string separated by
|
||||
! the optional character
|
||||
!SUBROUTINE field_count: accept two string (one of them is optional) and one integer
|
||||
! and count the number of fields in the string separated by a
|
||||
! blank or a tab character. If the optional string is specified
|
||||
! (it has anyway len=1) it is assumed as the separator character
|
||||
! Ignore any charcter following the exclamation mark
|
||||
! (fortran comment)
|
||||
!SUBROUTINE field_compare: accept two strings and one integer. Count the
|
||||
! fields contained in the first string and compare
|
||||
! it with the integer. If they are less than the
|
||||
! integer call the routine error and show by the
|
||||
! second string the name of the field where read-error
|
||||
! occurred.
|
||||
!SUBROUTINE p_err(I,R,S,L): call the appropriate error subroutine (the same as
|
||||
! flib/error.f90) depending on which kind of parameter
|
||||
! has to be printed
|
||||
|
||||
|
||||
SUBROUTINE field_compare(str, nf, var)
|
||||
!
|
||||
END IF
|
||||
!
|
||||
END DO
|
||||
!
|
||||
capital = in_char
|
||||
!
|
||||
RETURN
|
||||
!
|
||||
END FUNCTION capital
|
||||
!
|
||||
!
|
||||
!--------------------------------------------------------------------------
|
||||
PURE SUBROUTINE field_count( num, line, car )
|
||||
!--------------------------------------------------------------------------
|
||||
!
|
||||
IMPLICIT NONE
|
||||
|
||||
CHARACTER(LEN=*), INTENT(IN) :: var
|
||||
INTEGER, INTENT(IN) :: nf
|
||||
|
||||
CHARACTER(LEN=*), INTENT(OUT) :: str
|
||||
INTEGER :: nc
|
||||
|
||||
CALL field_count(nc, str)
|
||||
IF(nc .LT. nf) THEN
|
||||
CALL errore(' field_compare ', ' wrong number of fields: ' // TRIM(var), 1 )
|
||||
!
|
||||
INTEGER, INTENT(OUT) :: num
|
||||
CHARACTER(LEN=*), INTENT(IN) :: line
|
||||
CHARACTER(LEN=1), OPTIONAL, INTENT(IN) :: car
|
||||
CHARACTER(LEN=1) :: sep1, sep2
|
||||
INTEGER :: j
|
||||
!
|
||||
!
|
||||
num = 0
|
||||
!
|
||||
IF ( .NOT. present(car) ) THEN
|
||||
!
|
||||
sep1 = char(32) ! ... blank character
|
||||
sep2 = char(9) ! ... tab character
|
||||
!
|
||||
DO j = 2, MAX( LEN( line ), 256 )
|
||||
!
|
||||
IF ( line(j:j) == '!' .OR. line(j:j) == char(0) ) THEN
|
||||
!
|
||||
IF ( line(j-1:j-1) /= sep1 .AND. line(j-1:j-1) /= sep2 ) THEN
|
||||
!
|
||||
num = num + 1
|
||||
!
|
||||
END IF
|
||||
!
|
||||
EXIT
|
||||
!
|
||||
END IF
|
||||
!
|
||||
IF ( ( line(j:j) == sep1 .OR. line(j:j) == sep2 ) .AND. &
|
||||
( line(j-1:j-1) /= sep1 .AND. line(j-1:j-1) /= sep2 ) ) THEN
|
||||
!
|
||||
num = num + 1
|
||||
!
|
||||
END IF
|
||||
!
|
||||
END DO
|
||||
!
|
||||
ELSE
|
||||
!
|
||||
sep1 = car
|
||||
!
|
||||
DO j = 2, MAX( LEN( line ), 256 )
|
||||
!
|
||||
IF ( line(j:j) == '!' .OR. &
|
||||
line(j:j) == char(0) .OR. line(j:j) == char(32) ) THEN
|
||||
!
|
||||
IF ( line(j-1:j-1) /= sep1 ) num = num + 1
|
||||
!
|
||||
EXIT
|
||||
!
|
||||
END IF
|
||||
!
|
||||
IF ( line(j:j) == sep1 .AND. line(j-1:j-1) /= sep1 ) num = num + 1
|
||||
!
|
||||
END DO
|
||||
!
|
||||
END IF
|
||||
!
|
||||
RETURN
|
||||
!
|
||||
END SUBROUTINE field_count
|
||||
!
|
||||
!
|
||||
!--------------------------------------------------------------------------
|
||||
SUBROUTINE read_line( line, nfield, field, end_of_file )
|
||||
!--------------------------------------------------------------------------
|
||||
!
|
||||
USE mp, ONLY : mp_bcast
|
||||
USE mp_global, ONLY : group
|
||||
USE io_global, ONLY : ionode, ionode_id
|
||||
!
|
||||
IMPLICIT NONE
|
||||
!
|
||||
CHARACTER(LEN=*), INTENT(OUT) :: line
|
||||
CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: field
|
||||
INTEGER, OPTIONAL, INTENT(IN) :: nfield
|
||||
LOGICAL, OPTIONAL, INTENT(OUT) :: end_of_file
|
||||
LOGICAL :: tend
|
||||
!
|
||||
!
|
||||
IF( LEN( line ) < 256 ) THEN
|
||||
CALL errore(' read_line ', ' input line too short ', LEN( line ) )
|
||||
END IF
|
||||
!
|
||||
IF ( ionode ) THEN
|
||||
READ (5, fmt='(A256)', END=10) line
|
||||
tend = .FALSE.
|
||||
GO TO 20
|
||||
10 tend = .TRUE.
|
||||
20 CONTINUE
|
||||
END IF
|
||||
!
|
||||
CALL mp_bcast( tend, ionode_id, group )
|
||||
CALL mp_bcast( line, ionode_id, group )
|
||||
!
|
||||
IF( PRESENT(end_of_file) ) THEN
|
||||
end_of_file = tend
|
||||
ELSE IF( tend ) THEN
|
||||
CALL errore(' read_line ', ' end of file ', 0 )
|
||||
ELSE
|
||||
IF( PRESENT(field) ) CALL field_compare(line, nfield, field)
|
||||
END IF
|
||||
!
|
||||
RETURN
|
||||
!
|
||||
END SUBROUTINE read_line
|
||||
!
|
||||
!
|
||||
!--------------------------------------------------------------------------
|
||||
SUBROUTINE field_compare(str, nf, var)
|
||||
!--------------------------------------------------------------------------
|
||||
!
|
||||
IMPLICIT NONE
|
||||
!
|
||||
CHARACTER(LEN=*), INTENT(IN) :: var
|
||||
INTEGER, INTENT(IN) :: nf
|
||||
CHARACTER(LEN=*), INTENT(OUT) :: str
|
||||
INTEGER :: nc
|
||||
!
|
||||
CALL field_count( nc, str )
|
||||
!
|
||||
IF( nc < nf ) &
|
||||
CALL errore( ' field_compare ', &
|
||||
& ' wrong number of fields: ' // TRIM( var ), 1 )
|
||||
!
|
||||
RETURN
|
||||
!
|
||||
END SUBROUTINE field_compare
|
||||
|
||||
!
|
||||
!
|
||||
!--------------------------------------------------------------------------
|
||||
SUBROUTINE con_cam(num, line, car)
|
||||
!--------------------------------------------------------------------------
|
||||
CHARACTER(LEN=*) :: line
|
||||
CHARACTER(LEN=1) :: sep
|
||||
CHARACTER(LEN=1), OPTIONAL :: car
|
||||
|
|
@ -290,5 +358,5 @@ MODULE parser
|
|||
END DO
|
||||
RETURN
|
||||
END SUBROUTINE con_cam
|
||||
|
||||
!
|
||||
END MODULE parser
|
||||
|
|
|
|||
|
|
@ -18,7 +18,7 @@ SUBROUTINE cdiaghg( n, m, h, s, ldh, e, v )
|
|||
! ... LAPACK version - uses both ZHEGV and ZHEGVX
|
||||
!
|
||||
USE kinds, ONLY : DP
|
||||
USE mp_global, ONLY : npool, me_pool, root_pool, intra_pool_comm, my_image_id
|
||||
USE mp_global, ONLY : npool, me_pool, root_pool, intra_pool_comm
|
||||
USE mp, ONLY : mp_bcast
|
||||
!
|
||||
IMPLICIT NONE
|
||||
|
|
|
|||
|
|
@ -10,7 +10,7 @@ SUBROUTINE compute_scf( N_in, N_fin, stat )
|
|||
!----------------------------------------------------------------------------
|
||||
!
|
||||
! ... this subroutine is the main scf-driver for NEB
|
||||
! ... ( called by Modules/neb_base.f90, born_oppenheimer() subroutine )
|
||||
! ... ( called by Modules/neb_base.f90/born_oppenheimer() subroutine )
|
||||
!
|
||||
USE kinds, ONLY : DP
|
||||
USE input_parameters, ONLY : if_pos, sp_pos, startingwfc, startingpot, &
|
||||
|
|
@ -27,7 +27,7 @@ SUBROUTINE compute_scf( N_in, N_fin, stat )
|
|||
USE relax, ONLY : if_pos_ => if_pos
|
||||
USE extfield, ONLY : tefield, forcefield
|
||||
USE io_files, ONLY : prefix, tmp_dir, &
|
||||
iunneb, iunupdate
|
||||
iunneb, iunupdate, exit_file, iunexit
|
||||
USE io_global, ONLY : stdout
|
||||
USE formats, ONLY : scf_fmt, scf_fmt_para
|
||||
USE neb_variables, ONLY : pos, PES, PES_gradient, num_of_images, &
|
||||
|
|
@ -68,7 +68,7 @@ SUBROUTINE compute_scf( N_in, N_fin, stat )
|
|||
CALL mp_barrier( intra_image_comm )
|
||||
CALL mp_barrier( inter_image_comm )
|
||||
!
|
||||
istep = istep_neb
|
||||
istep = istep_neb + 1
|
||||
istat = 0
|
||||
!
|
||||
! ... only the first cpu on each image needs the tauold vector
|
||||
|
|
@ -86,7 +86,7 @@ SUBROUTINE compute_scf( N_in, N_fin, stat )
|
|||
! ... only the first cpu initializes the file needed by parallelization
|
||||
! ... among images
|
||||
!
|
||||
IF ( ionode ) CALL para_file_init()
|
||||
IF ( ionode ) CALL new_image_init()
|
||||
!
|
||||
image = N_in + my_image_id
|
||||
!
|
||||
|
|
@ -150,6 +150,8 @@ SUBROUTINE compute_scf( N_in, N_fin, stat )
|
|||
if_pos_(:,:) = if_pos(:,1:nat)
|
||||
ityp(:) = sp_pos(1:nat)
|
||||
!
|
||||
! ... initialization of the scf calculation
|
||||
!
|
||||
CALL init_run()
|
||||
!
|
||||
IF ( me_image == root_image ) THEN
|
||||
|
|
@ -198,9 +200,6 @@ SUBROUTINE compute_scf( N_in, N_fin, stat )
|
|||
CALL electrons()
|
||||
!
|
||||
IF ( .NOT. conv_elec ) THEN
|
||||
!
|
||||
WRITE( iunneb, '(/,5X,"WARNING : scf convergence NOT achieved",/, &
|
||||
& 5X,"stopping in compute_scf()...",/)' )
|
||||
!
|
||||
istat = 1
|
||||
!
|
||||
|
|
@ -291,6 +290,9 @@ SUBROUTINE compute_scf( N_in, N_fin, stat )
|
|||
stat = .FALSE.
|
||||
!
|
||||
CALL mp_min( suspended_image, inter_image_comm )
|
||||
!
|
||||
OPEN( UNIT = iunexit, FILE = TRIM( exit_file ) )
|
||||
CLOSE( UNIT = iunexit, STATUS = 'DELETE' )
|
||||
!
|
||||
END IF
|
||||
!
|
||||
|
|
@ -301,28 +303,28 @@ SUBROUTINE compute_scf( N_in, N_fin, stat )
|
|||
! ... internal procedures
|
||||
!
|
||||
!-----------------------------------------------------------------------
|
||||
SUBROUTINE para_file_init()
|
||||
SUBROUTINE new_image_init()
|
||||
!-----------------------------------------------------------------------
|
||||
!
|
||||
! ... this subroutine initializes the file needed for the
|
||||
! ... parallelization among images
|
||||
!
|
||||
USE io_files, ONLY : iunpara
|
||||
USE io_files, ONLY : iunnewimage
|
||||
USE mp_global, ONLY : nimage
|
||||
!
|
||||
IMPLICIT NONE
|
||||
!
|
||||
!
|
||||
OPEN( UNIT = iunpara, FILE = TRIM( tmp_dir_saved ) // &
|
||||
& TRIM( prefix ) // '.para' , STATUS = 'UNKNOWN' )
|
||||
OPEN( UNIT = iunnewimage, FILE = TRIM( tmp_dir_saved ) // &
|
||||
& TRIM( prefix ) // '.newimage' , STATUS = 'UNKNOWN' )
|
||||
!
|
||||
WRITE( iunpara, * ) N_in + nimage
|
||||
WRITE( iunnewimage, * ) N_in + nimage
|
||||
!
|
||||
CLOSE( UNIT = iunpara, STATUS = 'KEEP' )
|
||||
CLOSE( UNIT = iunnewimage, STATUS = 'KEEP' )
|
||||
!
|
||||
RETURN
|
||||
!
|
||||
END SUBROUTINE para_file_init
|
||||
END SUBROUTINE new_image_init
|
||||
!
|
||||
!-----------------------------------------------------------------------
|
||||
SUBROUTINE get_new_image( image )
|
||||
|
|
@ -332,7 +334,7 @@ SUBROUTINE compute_scf( N_in, N_fin, stat )
|
|||
! ... the *.BLOCK file is needed to avoid (when present) that
|
||||
! ... other jobs try to read/write on file "para"
|
||||
!
|
||||
USE io_files, ONLY : iunpara, iunblock
|
||||
USE io_files, ONLY : iunnewimage, iunblock
|
||||
!
|
||||
IMPLICIT NONE
|
||||
!
|
||||
|
|
@ -348,28 +350,28 @@ SUBROUTINE compute_scf( N_in, N_fin, stat )
|
|||
!
|
||||
IF ( ioerr > 0 ) CYCLE open_loop
|
||||
!
|
||||
INQUIRE( UNIT = iunpara, OPENED = opened )
|
||||
INQUIRE( UNIT = iunnewimage, OPENED = opened )
|
||||
!
|
||||
IF ( .NOT. opened ) THEN
|
||||
!
|
||||
INQUIRE( FILE = TRIM( tmp_dir_saved ) // &
|
||||
& TRIM( prefix ) // '.para', EXIST = exists )
|
||||
& TRIM( prefix ) // '.newimage', EXIST = exists )
|
||||
!
|
||||
IF ( exists ) THEN
|
||||
!
|
||||
OPEN( UNIT = iunpara, FILE = TRIM( tmp_dir_saved ) // &
|
||||
& TRIM( prefix ) // '.para' , STATUS = 'OLD' )
|
||||
OPEN( UNIT = iunnewimage, FILE = TRIM( tmp_dir_saved ) // &
|
||||
& TRIM( prefix ) // '.newimage' , STATUS = 'OLD' )
|
||||
!
|
||||
READ( iunpara, * ) image
|
||||
READ( iunnewimage, * ) image
|
||||
!
|
||||
CLOSE( UNIT = iunpara, STATUS = 'DELETE' )
|
||||
CLOSE( UNIT = iunnewimage, STATUS = 'DELETE' )
|
||||
!
|
||||
OPEN( UNIT = iunpara, FILE = TRIM( tmp_dir_saved ) // &
|
||||
& TRIM( prefix ) // '.para' , STATUS = 'NEW' )
|
||||
OPEN( UNIT = iunnewimage, FILE = TRIM( tmp_dir_saved ) // &
|
||||
& TRIM( prefix ) // '.newimage' , STATUS = 'NEW' )
|
||||
!
|
||||
WRITE( iunpara, * ) image + 1
|
||||
WRITE( iunnewimage, * ) image + 1
|
||||
!
|
||||
CLOSE( UNIT = iunpara, STATUS = 'KEEP' )
|
||||
CLOSE( UNIT = iunnewimage, STATUS = 'KEEP' )
|
||||
!
|
||||
EXIT open_loop
|
||||
!
|
||||
|
|
@ -390,49 +392,14 @@ SUBROUTINE compute_scf( N_in, N_fin, stat )
|
|||
!-----------------------------------------------------------------------
|
||||
!
|
||||
! ... this subroutine is used to send a stop signal to other images
|
||||
! ... the *.BLOCK file is needed to avoid (when present) that
|
||||
! ... other jobs try to read/write on file "para"
|
||||
!
|
||||
USE io_files, ONLY : iunpara, iunblock
|
||||
USE io_files, ONLY : iunexit, exit_file
|
||||
!
|
||||
IMPLICIT NONE
|
||||
!
|
||||
INTEGER :: ioerr
|
||||
LOGICAL :: opened, exists
|
||||
!
|
||||
!
|
||||
open_loop: DO
|
||||
!
|
||||
OPEN( UNIT = iunblock, FILE = TRIM( tmp_dir_saved ) // &
|
||||
& TRIM( prefix ) // '.BLOCK' , IOSTAT = ioerr, STATUS = 'NEW' )
|
||||
!
|
||||
IF ( ioerr > 0 ) CYCLE open_loop
|
||||
!
|
||||
INQUIRE( UNIT = iunpara, OPENED = opened )
|
||||
!
|
||||
IF ( .NOT. opened ) THEN
|
||||
!
|
||||
INQUIRE( FILE = TRIM( tmp_dir_saved ) // &
|
||||
& TRIM( prefix ) // '.para', EXIST = exists )
|
||||
!
|
||||
IF ( exists ) THEN
|
||||
!
|
||||
OPEN( UNIT = iunpara, FILE = TRIM( tmp_dir_saved ) // &
|
||||
& TRIM( prefix ) // '.para' , STATUS = 'UNKNOWN' )
|
||||
!
|
||||
WRITE( iunpara, * ) N_fin + 1
|
||||
!
|
||||
CLOSE( UNIT = iunpara, STATUS = 'KEEP' )
|
||||
!
|
||||
EXIT open_loop
|
||||
!
|
||||
END IF
|
||||
!
|
||||
END IF
|
||||
!
|
||||
END DO open_loop
|
||||
!
|
||||
CLOSE( UNIT = iunblock, STATUS = 'DELETE' )
|
||||
OPEN( UNIT = iunexit, FILE = TRIM( exit_file ) )
|
||||
CLOSE( UNIT = iunexit, STATUS = 'KEEP' )
|
||||
!
|
||||
RETURN
|
||||
!
|
||||
|
|
|
|||
|
|
@ -1302,7 +1302,7 @@ SUBROUTINE verify_tmpdir()
|
|||
! ... files needed by parallelization among images are removed
|
||||
!
|
||||
CALL delete_if_present( TRIM( file_path ) // '.BLOCK' )
|
||||
CALL delete_if_present( TRIM( file_path ) // '.para' )
|
||||
CALL delete_if_present( TRIM( file_path ) // '.newimage' )
|
||||
!
|
||||
END IF
|
||||
!
|
||||
|
|
|
|||
|
|
@ -21,27 +21,28 @@ SUBROUTINE update_pot()
|
|||
! ... atomic one,
|
||||
!
|
||||
! ... order = 2 extrapolate the wavefunctions:
|
||||
!
|
||||
! ... |psi(t+dt)> = 2*|psi(t)> - |psi(t-dt)>
|
||||
!
|
||||
! ... order = 3 extrapolate the wavefunctions with the second-order
|
||||
! ... formula:
|
||||
!
|
||||
! ... |psi(t+dt)> = |psi(t) +
|
||||
! ... + alpha0*(|psi(t)> - |psi(t-dt)>
|
||||
! ... + beta0* (|psi(t-dt)> - |psi(t-2*dt)>
|
||||
! ... + alpha0*( |psi(t)> - |psi(t-dt)> )
|
||||
! ... + beta0* ( |psi(t-dt)> - |psi(t-2*dt)> )
|
||||
!
|
||||
! ... where alpha0 and beta0 are calculated in "move_ions" so
|
||||
! ... that |tau'-tau(t+dt)| is minimum; tau' and tau(t+dt)
|
||||
! ... are respectively the atomic positions at time t+dt
|
||||
! ... and the extrapolated one:
|
||||
! ... where alpha0 and beta0 are calculated in
|
||||
! ... "find_alpha_and_beta()" so that |tau'-tau(t+dt)| is
|
||||
! ... minimum;
|
||||
! ... tau' and tau(t+dt) are respectively the atomic positions
|
||||
! ... at time t+dt and the extrapolated one:
|
||||
!
|
||||
! ... tau(t+dt) = tau(t) +
|
||||
! ... + alpha0*( tau(t) - tau(t-dt) )
|
||||
! ... tau(t+dt) = tau(t) + alpha0*( tau(t) - tau(t-dt) )
|
||||
! ... + beta0*( tau(t-dt) -tau(t-2*dt) )
|
||||
!
|
||||
!
|
||||
USE control_flags, ONLY : order, history
|
||||
USE io_files, ONLY : prefix, tmp_dir
|
||||
! USE mp_global, ONLY : mpime
|
||||
!
|
||||
IMPLICIT NONE
|
||||
!
|
||||
|
|
@ -106,15 +107,8 @@ SUBROUTINE update_pot()
|
|||
!
|
||||
CALL extrapolate_charge( rho_order )
|
||||
!
|
||||
! PRINT *, "HISTORY = ", HISTORY
|
||||
! PRINT *, "ORDER = ", ORDER
|
||||
! PRINT *, "RHO_ORDER = ", RHO_ORDER
|
||||
! PRINT *, "WFC_ORDER = ", WFC_ORDER
|
||||
!
|
||||
IF ( order >= 2 ) CALL extrapolate_wfcs( wfc_order )
|
||||
!
|
||||
! PRINT *, "mpime = ", mpime, "EXTRAPOLATION COMPLETED"
|
||||
!
|
||||
CALL stop_clock( 'update_pot' )
|
||||
!
|
||||
RETURN
|
||||
|
|
@ -275,7 +269,7 @@ SUBROUTINE extrapolate_wfcs( wfc_order )
|
|||
! ... of the basis of the t-dt and t time steps, according to a recipe
|
||||
! ... by Mead, Rev. Mod. Phys., vol 64, pag. 51 (1992), eqs. 3.20-3.29
|
||||
!
|
||||
#define ONE (1.D0,0.D0)
|
||||
#define ONE (1.D0,0.D0)
|
||||
#define ZERO (0.D0,0.D0)
|
||||
!
|
||||
USE io_global, ONLY : stdout
|
||||
|
|
@ -336,6 +330,7 @@ SUBROUTINE extrapolate_wfcs( wfc_order )
|
|||
ELSE IF ( wfc_order == 2 ) THEN
|
||||
!
|
||||
CALL diropn( iunoldwfc, TRIM( prefix ) // '.oldwfc', nwordwfc, exst )
|
||||
!
|
||||
IF ( order > 2 ) &
|
||||
CALL diropn( iunoldwfc2, TRIM( prefix ) // '.oldwfc2', nwordwfc, exst )
|
||||
!
|
||||
|
|
@ -381,7 +376,7 @@ SUBROUTINE extrapolate_wfcs( wfc_order )
|
|||
! ... becomes u_m * w_m
|
||||
!
|
||||
CALL ZGESVD( 'A', 'A', nbnd, nbnd, sp_m, nbnd, ew, u_m, nbnd, &
|
||||
w_m, nbnd, work, lwork, rwork, info )
|
||||
w_m, nbnd, work, lwork, rwork, info )
|
||||
!
|
||||
! ... check on eigenvalues
|
||||
!
|
||||
|
|
|
|||
Loading…
Reference in New Issue