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

- 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 2004-03-29 08:42:37 +00:00
parent 18a9b037c0
commit 28bfb48b47
9 changed files with 341 additions and 310 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Modules/check_stop.f90
View File

@ -47,7 +47,7 @@ MODULE check_stop
! !
IF( tinit ) & IF( tinit ) &
WRITE( UNIT = stdout, & WRITE( UNIT = stdout, &
FMT = '("WARNING: check_stop already initialized *** ")' ) FMT = '(/,5X,"WARNING: check_stop already initialized")' )
! !
IF ( val > 0.D0 ) max_seconds = val IF ( val > 0.D0 ) max_seconds = val
! !

16
Modules/formats.f90
View File

@ -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 ! This file is distributed under the terms of the
! GNU General Public License. See the file `License' ! GNU General Public License. See the file `License'
! in the root directory of the present distribution, ! in the root directory of the present distribution,
@ -10,6 +10,8 @@
MODULE formats MODULE formats
!--------------------------------------------------------------------------- !---------------------------------------------------------------------------
! !
! ... this module contains the I/O formats used by all NEB-routines
!
CHARACTER (LEN=*), PARAMETER :: & CHARACTER (LEN=*), PARAMETER :: &
lattice_vectors = "(3(2X,F14.10),/,3(2X,F14.10),/,3(2X,F14.10))" 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)", & & "'; self-consistency for image ', I3)", &
scf_fmt_para = "(5X,'cpu = ',I2,'; tcpu = ',F8.2," // & scf_fmt_para = "(5X,'cpu = ',I2,'; tcpu = ',F8.2," // &
& "'; self-consistency for image ', I3)", & & "'; self-consistency for image ', I3)", &
run_output = "(/,5X,'iteration: ',I3,5X,'E activation ='," // & run_output = "(/,5X,'iteration:',I4,4X,'E activation ='," // &
& " F10.6,5X,'error =',F10.6,/)", & & " F6.3,' eV',4X,'error =',F8.4,' eV / bohr'/)", &
run_output_T_const = "(/,5X,'iteration: ',I3,5X,'temperature ='," // & run_output_T_const = "(/,5X,'iteration:',I4,4X,'temperature ='," // &
& " F10.2,5X,'forces =',F10.6)", & & " F8.2,' K',4X,'forces =',F8.4,' eV / bohr')", &
final_output = "(5X,'image: ',I2,' Energy = ',F16.8," // & final_output = "(5X,'image: ',I2,' E tot = ',F16.8," // &
& "' Error = ',F8.5)" & "' eV error = ',F8.4,' eV / bohr')"
! !
CHARACTER (LEN=*), PARAMETER :: & CHARACTER (LEN=*), PARAMETER :: &
stringfmt = "(5X,A,T35,' = ',A)" stringfmt = "(5X,A,T35,' = ',A)"

2
Modules/io_files.f90
View File

@ -86,7 +86,7 @@
! !
INTEGER :: iunexit = 26 ! unit for a soft exit INTEGER :: iunexit = 26 ! unit for a soft exit
INTEGER :: iunupdate = 27 ! unit for saving old positions (extrapolation) 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) INTEGER :: iunblock = 29 ! as above (blocking file)
! !
! ... NEB specific ! ... NEB specific

119
Modules/neb_base.f90
View File

@ -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 ! This file is distributed under the terms of the
! GNU General Public License. See the file `License' ! GNU General Public License. See the file `License'
! in the root directory of the present distribution, ! in the root directory of the present distribution,
@ -169,6 +169,8 @@ MODULE neb_base
END IF END IF
! !
ELSE ELSE
!
! ... linear interpolation
! !
ALLOCATE( d_R(dim) ) ALLOCATE( d_R(dim) )
! !
@ -186,6 +188,8 @@ MODULE neb_base
! !
END IF END IF
! !
! ... the actual number of degrees of freedom is computed
!
CALL compute_deg_of_freedom() CALL compute_deg_of_freedom()
! !
! ... details of the calculation are written on output (only by ionode) ! ... details of the calculation are written on output (only by ionode)
@ -222,7 +226,7 @@ MODULE neb_base
! !
CONTAINS CONTAINS
! !
SUBROUTINE compute_deg_of_freedom SUBROUTINE compute_deg_of_freedom()
! !
USE ions_base, ONLY : nat USE ions_base, ONLY : nat
USE input_parameters, ONLY : if_pos USE input_parameters, ONLY : if_pos
@ -230,7 +234,7 @@ MODULE neb_base
! !
IMPLICIT NONE IMPLICIT NONE
! !
INTEGER :: ia INTEGER :: ia
! !
! !
deg_of_freedom = 0 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() SUBROUTINE compute_tangent()
!------------------------------------------------------------------------ !------------------------------------------------------------------------
! !
@ -325,16 +292,19 @@ MODULE neb_base
!------------------------------------------------------------------------ !------------------------------------------------------------------------
! !
USE constants, ONLY : pi, eps32 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, & k_max, k_min, k, PES, PES_gradient, &
VEC_scheme VEC_scheme, elastic_gradient, tangent
USE basic_algebra_routines, ONLY : norm USE supercell, ONLY : pbc
USE basic_algebra_routines
! !
IMPLICIT NONE IMPLICIT NONE
! !
! ... local variables ! ... 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) :: delta_E
REAL (KIND=DP) :: norm_grad_V, norm_grad_V_min, norm_grad_V_max REAL (KIND=DP) :: norm_grad_V, norm_grad_V_min, norm_grad_V_max
! !
@ -353,10 +323,10 @@ MODULE neb_base
! !
END IF 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 ) * & k(i) = 0.25D0 * ( ( k_max + k_min ) - ( k_max - k_min ) * &
COS( pi * ( PES(image) - Emin ) / delta_E ) ) COS( pi * ( PES(i) - Emin ) / delta_E ) )
! !
END DO END DO
! !
@ -365,27 +335,55 @@ MODULE neb_base
norm_grad_V_min = + 1.0D32 norm_grad_V_min = + 1.0D32
norm_grad_V_max = - 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_min ) norm_grad_V_min = norm_grad_V
IF ( norm_grad_V > norm_grad_V_max ) norm_grad_V_max = norm_grad_V IF ( norm_grad_V > norm_grad_V_max ) norm_grad_V_max = norm_grad_V
! !
END DO 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 ) * & k(i) = 0.25D0 * ( ( k_max + k_min ) - ( k_max - k_min ) * &
COS( pi * ( norm_grad_V - norm_grad_V_min ) / & COS( pi * ( norm_grad_V - norm_grad_V_min ) / &
( norm_grad_V_max - norm_grad_V_min ) ) ) ( norm_grad_V_max - norm_grad_V_min ) ) )
! !
END DO END DO
! !
END IF 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 RETURN
! !
END SUBROUTINE elastic_constants END SUBROUTINE elastic_constants
@ -400,7 +398,7 @@ MODULE neb_base
elastic_gradient, PES_gradient, k, & elastic_gradient, PES_gradient, k, &
num_of_images, free_minimization, & num_of_images, free_minimization, &
climbing, tangent, lmol_dyn climbing, tangent, lmol_dyn
USE basic_algebra_routines, ONLY : norm USE basic_algebra_routines
! !
IMPLICIT NONE IMPLICIT NONE
! !
@ -410,7 +408,8 @@ MODULE neb_base
! !
! ... end of local variables ! ... end of local variables
! !
CALL elastic_constants !
CALL elastic_constants()
! !
gradient_loop: DO i = 1, num_of_images gradient_loop: DO i = 1, num_of_images
! !
@ -447,13 +446,13 @@ MODULE neb_base
IF ( climbing(i) ) THEN IF ( climbing(i) ) THEN
! !
grad(:,i) = grad(:,i) - 2.D0 * tangent(:,i) * & 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. & ELSE IF ( ( .NOT. free_minimization(i) ) .AND. &
( i > 1 ) .AND. ( i < num_of_images ) ) THEN ( i > 1 ) .AND. ( i < num_of_images ) ) THEN
! !
grad(:,i) = grad(:,i) + elastic_gradient - tangent(:,i) * & grad(:,i) = elastic_gradient + PES_gradient(:,i) - &
DOT_PRODUCT( PES_gradient(:,i) , tangent(:,i) ) tangent(:,i) * ( PES_gradient(:,i) .dot. tangent(:,i) )
! !
END IF END IF
! !
@ -896,7 +895,7 @@ MODULE neb_base
IF ( ionode ) & IF ( ionode ) &
WRITE( UNIT = iunneb, & WRITE( UNIT = iunneb, &
FMT = '(/,5X,"NEB: convergence achieved in ",I3, & FMT = '(/,5X,"NEB: convergence achieved in ",I3, &
& " iterations" )' ) & " iterations" )' ) istep_neb
! !
conv_neb = .TRUE. conv_neb = .TRUE.
! !

392
Modules/parser.f90
View File

@ -5,11 +5,30 @@
! in the root directory of the present distribution, ! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt . ! 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 MODULE parser
!---------------------------------------------------------------------------- !----------------------------------------------------------------------------
! !
USE io_global, ONLY : stdout USE io_global, ONLY : stdout
USE kinds USE kinds
! !
CONTAINS CONTAINS
@ -52,14 +71,15 @@ MODULE parser
! !
! !
!-------------------------------------------------------------------------- !--------------------------------------------------------------------------
SUBROUTINE delete_if_present( filename ) SUBROUTINE delete_if_present( filename, in_warning )
!-------------------------------------------------------------------------- !--------------------------------------------------------------------------
! !
IMPLICIT NONE IMPLICIT NONE
! !
CHARACTER(LEN=*) :: filename CHARACTER(LEN=*), INTENT(IN) :: filename
LOGICAL :: exst, opnd LOGICAL, OPTIONAL, INTENT(IN) :: in_warning
INTEGER :: iunit LOGICAL :: exst, opnd, warning
INTEGER :: iunit
! !
INQUIRE( FILE = filename, EXIST = exst ) INQUIRE( FILE = filename, EXIST = exst )
! !
@ -70,11 +90,17 @@ MODULE parser
INQUIRE( UNIT = iunit, OPENED = opnd ) INQUIRE( UNIT = iunit, OPENED = opnd )
! !
IF ( .NOT. opnd ) THEN IF ( .NOT. opnd ) THEN
!
warning = .FALSE.
!
IF ( PRESENT( in_warning ) ) warning = in_warning
! !
OPEN( UNIT = iunit, FILE = filename , STATUS = 'OLD' ) OPEN( UNIT = iunit, FILE = filename , STATUS = 'OLD' )
CLOSE( UNIT = iunit, STATUS = 'DELETE' ) 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 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 IMPLICIT NONE
character (len=*) :: string1, string2 !
integer :: len1, len2, l 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 len1 = LEN_TRIM( string1 )
if (string1 (1:len1) .eq.string2 (l:l + len1 - 1) ) then len2 = LEN_TRIM( string2 )
matches = .true. !
return DO l = 1, ( len2 - len1 + 1 )
endif !
enddo IF ( string1(1:len1) == string2(l:(l+len1-1)) ) THEN
!
matches = .false. matches = .TRUE.
return !
end function matches 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 ! ... converts character to capital if lowercase
! copy character to output in all other cases ! ... copy character to output in all other cases
! !
implicit none
character (len=1) :: capital, character
!
character(len=26) :: minuscole='abcdefghijklmnopqrstuvwxyz', &
maiuscole='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
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)
IMPLICIT NONE IMPLICIT NONE
!
CHARACTER(LEN=*), INTENT(IN) :: var CHARACTER(LEN=1), INTENT(IN) :: in_char
INTEGER, INTENT(IN) :: nf CHARACTER(LEN=1) :: capital
CHARACTER(LEN=26) :: lower = 'abcdefghijklmnopqrstuvwxyz', &
CHARACTER(LEN=*), INTENT(OUT) :: str upper = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
INTEGER :: nc INTEGER :: i
!
CALL field_count(nc, str) !
IF(nc .LT. nf) THEN DO i=1, 26
CALL errore(' field_compare ', ' wrong number of fields: ' // TRIM(var), 1 ) !
IF ( in_char == lower(i:i) ) THEN
!
capital = upper(i:i)
!
RETURN
!
END IF
!
END DO
!
capital = in_char
!
RETURN
!
END FUNCTION capital
!
!
!--------------------------------------------------------------------------
PURE SUBROUTINE field_count( num, line, car )
!--------------------------------------------------------------------------
!
IMPLICIT NONE
!
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 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 END SUBROUTINE field_compare
!
!
!--------------------------------------------------------------------------
SUBROUTINE con_cam(num, line, car) SUBROUTINE con_cam(num, line, car)
!--------------------------------------------------------------------------
CHARACTER(LEN=*) :: line CHARACTER(LEN=*) :: line
CHARACTER(LEN=1) :: sep CHARACTER(LEN=1) :: sep
CHARACTER(LEN=1), OPTIONAL :: car CHARACTER(LEN=1), OPTIONAL :: car
@ -290,5 +358,5 @@ MODULE parser
END DO END DO
RETURN RETURN
END SUBROUTINE con_cam END SUBROUTINE con_cam
!
END MODULE parser END MODULE parser

2
PW/cdiaghg.f90
View File

@ -18,7 +18,7 @@ SUBROUTINE cdiaghg( n, m, h, s, ldh, e, v )
! ... LAPACK version - uses both ZHEGV and ZHEGVX ! ... LAPACK version - uses both ZHEGV and ZHEGVX
! !
USE kinds, ONLY : DP 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 USE mp, ONLY : mp_bcast
! !
IMPLICIT NONE IMPLICIT NONE

93
PW/compute_scf.f90
View File

@ -10,7 +10,7 @@ SUBROUTINE compute_scf( N_in, N_fin, stat )
!---------------------------------------------------------------------------- !----------------------------------------------------------------------------
! !
! ... this subroutine is the main scf-driver for NEB ! ... 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 kinds, ONLY : DP
USE input_parameters, ONLY : if_pos, sp_pos, startingwfc, startingpot, & 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 relax, ONLY : if_pos_ => if_pos
USE extfield, ONLY : tefield, forcefield USE extfield, ONLY : tefield, forcefield
USE io_files, ONLY : prefix, tmp_dir, & USE io_files, ONLY : prefix, tmp_dir, &
iunneb, iunupdate iunneb, iunupdate, exit_file, iunexit
USE io_global, ONLY : stdout USE io_global, ONLY : stdout
USE formats, ONLY : scf_fmt, scf_fmt_para USE formats, ONLY : scf_fmt, scf_fmt_para
USE neb_variables, ONLY : pos, PES, PES_gradient, num_of_images, & 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( intra_image_comm )
CALL mp_barrier( inter_image_comm ) CALL mp_barrier( inter_image_comm )
! !
istep = istep_neb istep = istep_neb + 1
istat = 0 istat = 0
! !
! ... only the first cpu on each image needs the tauold vector ! ... 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 ! ... only the first cpu initializes the file needed by parallelization
! ... among images ! ... among images
! !
IF ( ionode ) CALL para_file_init() IF ( ionode ) CALL new_image_init()
! !
image = N_in + my_image_id image = N_in + my_image_id
! !
@ -150,6 +150,8 @@ SUBROUTINE compute_scf( N_in, N_fin, stat )
if_pos_(:,:) = if_pos(:,1:nat) if_pos_(:,:) = if_pos(:,1:nat)
ityp(:) = sp_pos(1:nat) ityp(:) = sp_pos(1:nat)
! !
! ... initialization of the scf calculation
!
CALL init_run() CALL init_run()
! !
IF ( me_image == root_image ) THEN IF ( me_image == root_image ) THEN
@ -199,9 +201,6 @@ SUBROUTINE compute_scf( N_in, N_fin, stat )
! !
IF ( .NOT. conv_elec ) THEN IF ( .NOT. conv_elec ) THEN
! !
WRITE( iunneb, '(/,5X,"WARNING : scf convergence NOT achieved",/, &
& 5X,"stopping in compute_scf()...",/)' )
!
istat = 1 istat = 1
! !
CALL stop_other_images() CALL stop_other_images()
@ -292,6 +291,9 @@ SUBROUTINE compute_scf( N_in, N_fin, stat )
! !
CALL mp_min( suspended_image, inter_image_comm ) CALL mp_min( suspended_image, inter_image_comm )
! !
OPEN( UNIT = iunexit, FILE = TRIM( exit_file ) )
CLOSE( UNIT = iunexit, STATUS = 'DELETE' )
!
END IF END IF
! !
RETURN RETURN
@ -301,28 +303,28 @@ SUBROUTINE compute_scf( N_in, N_fin, stat )
! ... internal procedures ! ... internal procedures
! !
!----------------------------------------------------------------------- !-----------------------------------------------------------------------
SUBROUTINE para_file_init() SUBROUTINE new_image_init()
!----------------------------------------------------------------------- !-----------------------------------------------------------------------
! !
! ... this subroutine initializes the file needed for the ! ... this subroutine initializes the file needed for the
! ... parallelization among images ! ... parallelization among images
! !
USE io_files, ONLY : iunpara USE io_files, ONLY : iunnewimage
USE mp_global, ONLY : nimage USE mp_global, ONLY : nimage
! !
IMPLICIT NONE IMPLICIT NONE
! !
! !
OPEN( UNIT = iunpara, FILE = TRIM( tmp_dir_saved ) // & OPEN( UNIT = iunnewimage, FILE = TRIM( tmp_dir_saved ) // &
& TRIM( prefix ) // '.para' , STATUS = 'UNKNOWN' ) & 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 RETURN
! !
END SUBROUTINE para_file_init END SUBROUTINE new_image_init
! !
!----------------------------------------------------------------------- !-----------------------------------------------------------------------
SUBROUTINE get_new_image( image ) 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 ! ... the *.BLOCK file is needed to avoid (when present) that
! ... other jobs try to read/write on file "para" ! ... other jobs try to read/write on file "para"
! !
USE io_files, ONLY : iunpara, iunblock USE io_files, ONLY : iunnewimage, iunblock
! !
IMPLICIT NONE IMPLICIT NONE
! !
@ -348,28 +350,28 @@ SUBROUTINE compute_scf( N_in, N_fin, stat )
! !
IF ( ioerr > 0 ) CYCLE open_loop IF ( ioerr > 0 ) CYCLE open_loop
! !
INQUIRE( UNIT = iunpara, OPENED = opened ) INQUIRE( UNIT = iunnewimage, OPENED = opened )
! !
IF ( .NOT. opened ) THEN IF ( .NOT. opened ) THEN
! !
INQUIRE( FILE = TRIM( tmp_dir_saved ) // & INQUIRE( FILE = TRIM( tmp_dir_saved ) // &
& TRIM( prefix ) // '.para', EXIST = exists ) & TRIM( prefix ) // '.newimage', EXIST = exists )
! !
IF ( exists ) THEN IF ( exists ) THEN
! !
OPEN( UNIT = iunpara, FILE = TRIM( tmp_dir_saved ) // & OPEN( UNIT = iunnewimage, FILE = TRIM( tmp_dir_saved ) // &
& TRIM( prefix ) // '.para' , STATUS = 'OLD' ) & 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 ) // & OPEN( UNIT = iunnewimage, FILE = TRIM( tmp_dir_saved ) // &
& TRIM( prefix ) // '.para' , STATUS = 'NEW' ) & 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 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 ! ... 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 IMPLICIT NONE
! !
INTEGER :: ioerr
LOGICAL :: opened, exists
! !
! OPEN( UNIT = iunexit, FILE = TRIM( exit_file ) )
open_loop: DO CLOSE( UNIT = iunexit, STATUS = 'KEEP' )
!
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' )
! !
RETURN RETURN
! !

2
PW/input.f90
View File

@ -1302,7 +1302,7 @@ SUBROUTINE verify_tmpdir()
! ... files needed by parallelization among images are removed ! ... files needed by parallelization among images are removed
! !
CALL delete_if_present( TRIM( file_path ) // '.BLOCK' ) 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 END IF
! !

31
PW/update_pot.f90
View File

@ -21,27 +21,28 @@ SUBROUTINE update_pot()
! ... atomic one, ! ... atomic one,
! !
! ... order = 2 extrapolate the wavefunctions: ! ... order = 2 extrapolate the wavefunctions:
!
! ... |psi(t+dt)> = 2*|psi(t)> - |psi(t-dt)> ! ... |psi(t+dt)> = 2*|psi(t)> - |psi(t-dt)>
! !
! ... order = 3 extrapolate the wavefunctions with the second-order ! ... order = 3 extrapolate the wavefunctions with the second-order
! ... formula: ! ... formula:
!
! ... |psi(t+dt)> = |psi(t) + ! ... |psi(t+dt)> = |psi(t) +
! ... + alpha0*(|psi(t)> - |psi(t-dt)> ! ... + alpha0*( |psi(t)> - |psi(t-dt)> )
! ... + beta0* (|psi(t-dt)> - |psi(t-2*dt)> ! ... + beta0* ( |psi(t-dt)> - |psi(t-2*dt)> )
! !
! ... where alpha0 and beta0 are calculated in "move_ions" so ! ... where alpha0 and beta0 are calculated in
! ... that |tau'-tau(t+dt)| is minimum; tau' and tau(t+dt) ! ... "find_alpha_and_beta()" so that |tau'-tau(t+dt)| is
! ... are respectively the atomic positions at time t+dt ! ... minimum;
! ... and the extrapolated one: ! ... tau' and tau(t+dt) are respectively the atomic positions
! ... at time t+dt and the extrapolated one:
! !
! ... tau(t+dt) = tau(t) + ! ... tau(t+dt) = tau(t) + alpha0*( tau(t) - tau(t-dt) )
! ... + alpha0*( tau(t) - tau(t-dt) )
! ... + beta0*( tau(t-dt) -tau(t-2*dt) ) ! ... + beta0*( tau(t-dt) -tau(t-2*dt) )
! !
! !
USE control_flags, ONLY : order, history USE control_flags, ONLY : order, history
USE io_files, ONLY : prefix, tmp_dir USE io_files, ONLY : prefix, tmp_dir
! USE mp_global, ONLY : mpime
! !
IMPLICIT NONE IMPLICIT NONE
! !
@ -106,15 +107,8 @@ SUBROUTINE update_pot()
! !
CALL extrapolate_charge( rho_order ) 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 ) IF ( order >= 2 ) CALL extrapolate_wfcs( wfc_order )
! !
! PRINT *, "mpime = ", mpime, "EXTRAPOLATION COMPLETED"
!
CALL stop_clock( 'update_pot' ) CALL stop_clock( 'update_pot' )
! !
RETURN 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 ! ... 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 ! ... 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) #define ZERO (0.D0,0.D0)
! !
USE io_global, ONLY : stdout USE io_global, ONLY : stdout
@ -336,6 +330,7 @@ SUBROUTINE extrapolate_wfcs( wfc_order )
ELSE IF ( wfc_order == 2 ) THEN ELSE IF ( wfc_order == 2 ) THEN
! !
CALL diropn( iunoldwfc, TRIM( prefix ) // '.oldwfc', nwordwfc, exst ) CALL diropn( iunoldwfc, TRIM( prefix ) // '.oldwfc', nwordwfc, exst )
!
IF ( order > 2 ) & IF ( order > 2 ) &
CALL diropn( iunoldwfc2, TRIM( prefix ) // '.oldwfc2', nwordwfc, exst ) CALL diropn( iunoldwfc2, TRIM( prefix ) // '.oldwfc2', nwordwfc, exst )
! !
@ -381,7 +376,7 @@ SUBROUTINE extrapolate_wfcs( wfc_order )
! ... becomes u_m * w_m ! ... becomes u_m * w_m
! !
CALL ZGESVD( 'A', 'A', nbnd, nbnd, sp_m, nbnd, ew, u_m, nbnd, & 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 ! ... check on eigenvalues
! !