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

Other bugs fixed. Performance is slightly better than yesterday. 

C.S.


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@432 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
sbraccia 2003-11-26 09:44:49 +00:00
parent c0a675e6e2
commit 29e2121426
1 changed files with 18 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
Modules/bfgs_module.f90
View File

@ -5,8 +5,6 @@
! 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 .
! !
#include "machine.h"
!
!---------------------------------------------------------------------------- !----------------------------------------------------------------------------
MODULE basic_algebra_routines MODULE basic_algebra_routines
!---------------------------------------------------------------------------- !----------------------------------------------------------------------------
@ -68,23 +66,14 @@ MODULE basic_algebra_routines
REAL (KIND=DP), INTENT(IN) :: vector(:) REAL (KIND=DP), INTENT(IN) :: vector(:)
REAL (KIND=DP), INTENT(IN) :: matrix(:,:) REAL (KIND=DP), INTENT(IN) :: matrix(:,:)
REAL (KIND=DP) :: matrix_times_vector(SIZE( vector )) REAL (KIND=DP) :: matrix_times_vector(SIZE( vector ))
REAL (KIND=DP) :: accumulator INTEGER :: i, dim
INTEGER :: i, j, dim
! !
! !
dim = SIZE( vector ) dim = SIZE( vector )
! !
DO i = 1, dim DO i = 1, dim
! !
accumulator = 0.D0 matrix_times_vector(i) = matrix(i,:) .dot. vector(:)
!
DO j = 1, dim
!
accumulator = accumulator + matrix(j,i) * vector(j)
!
END DO
!
matrix_times_vector(i) = accumulator
! !
END DO END DO
! !
@ -100,23 +89,14 @@ MODULE basic_algebra_routines
REAL (KIND=DP), INTENT(IN) :: vector(:) REAL (KIND=DP), INTENT(IN) :: vector(:)
REAL (KIND=DP), INTENT(IN) :: matrix(:,:) REAL (KIND=DP), INTENT(IN) :: matrix(:,:)
REAL (KIND=DP) :: vector_times_matrix(SIZE( vector )) REAL (KIND=DP) :: vector_times_matrix(SIZE( vector ))
REAL (KIND=DP) :: accumulator INTEGER :: i, dim
INTEGER :: i, j, dim
! !
! !
dim = SIZE( vector ) dim = SIZE( vector )
! !
DO i = 1, dim DO i = 1, dim
! !
accumulator = 0.D0 vector_times_matrix(i) = vector(:) .dot. matrix(:,i)
!
DO j = 1, dim
!
accumulator = accumulator + vector(j) * matrix(i,j)
!
END DO
!
vector_times_matrix(i) = accumulator
! !
END DO END DO
! !
@ -158,6 +138,8 @@ MODULE basic_algebra_routines
INTEGER :: i INTEGER :: i
! !
! !
identity = 0.D0
!
DO i = 1, dim DO i = 1, dim
! !
identity(i,i) = 1.D0 identity(i,i) = 1.D0
@ -361,7 +343,6 @@ MODULE bfgs_module
! !
CHARACTER (LEN=*), INTENT(IN) :: scratch CHARACTER (LEN=*), INTENT(IN) :: scratch
INTEGER, INTENT(IN) :: dim INTEGER, INTENT(IN) :: dim
INTEGER :: i
CHARACTER (LEN=256) :: bfgs_file CHARACTER (LEN=256) :: bfgs_file
LOGICAL :: file_exists LOGICAL :: file_exists
! !
@ -393,13 +374,7 @@ MODULE bfgs_module
gradient_old = 0.D0 gradient_old = 0.D0
bfgs_step_old = 0.D0 bfgs_step_old = 0.D0
trust_radius_old = trust_radius_ini trust_radius_old = trust_radius_ini
inverse_hessian = 0.D0 inverse_hessian = identity(dim)
!
DO i = 1, dim
!
inverse_hessian(i,i) = 1.D0
!
END DO
! !
END IF END IF
! !
@ -445,12 +420,10 @@ MODULE bfgs_module
! !
REAL(KIND=DP), INTENT(IN) :: gradient(:) REAL(KIND=DP), INTENT(IN) :: gradient(:)
INTEGER, INTENT(IN) :: dim INTEGER, INTENT(IN) :: dim
REAL(KIND=DP), ALLOCATABLE :: gamma(:) REAL(KIND=DP) :: gamma(dim)
REAL(KIND=DP) :: sdotgamma REAL(KIND=DP) :: sdotgamma
! !
! !
ALLOCATE( gamma(dim) )
!
gamma = gradient - gradient_old gamma = gradient - gradient_old
! !
sdotgamma = bfgs_step_old .dot. gamma sdotgamma = bfgs_step_old .dot. gamma
@ -461,16 +434,14 @@ MODULE bfgs_module
! !
ELSE ELSE
! !
inverse_hessian = inverse_hessian + & inverse_hessian = inverse_hessian + ( identity(dim) + &
( identity(dim) + ( gamma .dot. ( inverse_hessian * gamma ) ) / sdotgamma ) * & ( gamma .dot. ( inverse_hessian * gamma ) ) / sdotgamma ) * &
matrix( bfgs_step_old, bfgs_step_old ) / sdotgamma - & matrix( bfgs_step_old, bfgs_step_old ) / sdotgamma - &
( matrix( bfgs_step_old, gamma * inverse_hessian ) + & ( matrix( bfgs_step_old, ( gamma * inverse_hessian ) ) + &
matrix( inverse_hessian * gamma, bfgs_step_old ) ) / sdotgamma matrix( ( inverse_hessian * gamma ), bfgs_step_old ) ) / sdotgamma
! !
END IF END IF
! !
DEALLOCATE( gamma )
!
END SUBROUTINE update_inverse_hessian END SUBROUTINE update_inverse_hessian
! !
! !
@ -508,7 +479,6 @@ MODULE bfgs_module
INTEGER, INTENT(IN) :: dim INTEGER, INTENT(IN) :: dim
INTEGER, INTENT(IN) :: stdout INTEGER, INTENT(IN) :: stdout
LOGICAL, INTENT(OUT) :: conv_bfgs LOGICAL, INTENT(OUT) :: conv_bfgs
INTEGER :: i
REAL(KIND=DP) :: a REAL(KIND=DP) :: a
LOGICAL :: ltest LOGICAL :: ltest
! !
@ -549,13 +519,7 @@ MODULE bfgs_module
! !
WRITE( stdout, '(/,5X,"resetting bfgs history",/)' ) WRITE( stdout, '(/,5X,"resetting bfgs history",/)' )
! !
inverse_hessian = 0.D0 inverse_hessian = identity(dim)
!
DO i = 1, dim
!
inverse_hessian(i,i) = 1.D0
!
END DO
! !
END IF END IF
! !