1!
2! Copyright (C) 2003-2006 Quantum ESPRESSO group
3! This file is distributed under the terms of the
4! GNU General Public License. See the file `License'
5! in the root directory of the present distribution,
6! or http://www.gnu.org/copyleft/gpl.txt .
7!
8!--------------------------------------------------------------------------
9MODULE path_variables
10  !---------------------------------------------------------------------------
11  !
12  ! ... This module contains all variables needed by path optimisations
13  !
14  ! ... Written by Carlo Sbraccia ( 2003-2006 )
15  !
16  USE kinds, ONLY : DP
17  !
18  IMPLICIT NONE
19  !
20  SAVE
21  !
22  ! ... "general" variables :
23  !
24  LOGICAL :: lneb, lsmd
25  !
26  LOGICAL :: restart
27  !
28  LOGICAL :: &
29       conv_path                  ! .TRUE. when "path" convergence has been
30                                  !        achieved
31  LOGICAL :: &
32       first_last_opt,           &! if .TRUE. the first and the last image
33                                  !           are optimised too.
34       use_masses,               &! if .TRUE. mass weighted coordinates are
35                                  !           used
36       fixed_tan,                &! if. TRUE. the projection is done using the
37                                  !           tangent of the average path
38       use_freezing,             &! if .TRUE. images are optimised according
39                                  !           to their error (see frozen array)
40       tune_load_balance          ! if .TRUE. the load balance for image
41                                  !           parallelisation is tuned at
42                                  !           runtime
43  INTEGER :: &
44       dim1,                      &! dimension of the configuration space
45       num_of_images,            &! number of images
46       deg_of_freedom,           &! number of degrees of freedom
47                                  ! ( dim1 - #( of fixed coordinates ) )
48       pending_image              ! last image for which scf has not been
49                                  ! achieved
50  REAL(DP) :: &
51       ds,                       &! the optimization step
52       path_thr,                 &! convergence threshold
53       temp_req,                 &! required temperature
54       activation_energy,        &! forward activatation energy
55       err_max,                  &! the largest error
56       path_length                ! length of the path
57  LOGICAL :: &
58       lsteep_des  = .FALSE.,    &! .TRUE. if opt_scheme = "sd"
59       lquick_min  = .FALSE.,    &! .TRUE. if opt_scheme = "quick-min"
60       lbroyden    = .FALSE.,    &! .TRUE. if opt_scheme = "broyden"
61       lbroyden2   = .FALSE.,    &! .TRUE. if opt_scheme = "broyden2"
62       llangevin   = .FALSE.      ! .TRUE. if opt_scheme = "langevin"
63  INTEGER :: &
64       istep_path,               &! iteration in the optimization procedure
65       nstep_path                 ! maximum number of iterations
66  !
67  ! ... "general" real space arrays
68  !
69  REAL(DP), ALLOCATABLE :: &
70       pes(:),                   &! the potential enrgy along the path
71       error(:)                   ! the error from the true MEP
72  REAL(DP), ALLOCATABLE :: &
73       pos(:,:),                 &! reaction path
74       grad_pes(:,:),            &! gradients acting on the path
75       tangent(:,:)               ! tangent to the path
76  INTEGER, ALLOCATABLE :: &
77       fix_atom_pos(:,:)                ! 0 or 1, if 0 fixed atom
78  LOGICAL, ALLOCATABLE :: &
79       frozen(:)                  ! .TRUE. if the image or mode has not
80                                  !        to be optimized
81  !
82  ! ... "neb specific" variables :
83  !
84  LOGICAL, ALLOCATABLE :: &
85       climbing(:)                ! .TRUE. if the image is required to climb
86  CHARACTER(LEN=20) :: &
87       CI_scheme                  ! Climbing Image scheme
88  INTEGER :: &
89       Emax_index                 ! index of the image with the highest energy
90  !
91  REAL (DP) :: &
92       k_max,                    &!
93       k_min,                    &!
94       Emax,                     &!
95       Emin                       !
96  !
97  ! ... real space arrays
98  !
99  REAL(DP), ALLOCATABLE :: &
100       elastic_grad(:),          &! elastic part of the gradients
101       mass(:),                  &! atomic masses
102       k(:)                       ! elastic constants
103  REAL(DP), ALLOCATABLE :: &
104       posold(:,:),              &! old positions (for the quick-min)
105       grad(:,:),                &!
106       lang(:,:)                  ! langevin random force
107  !
108  CONTAINS
109     !
110     !----------------------------------------------------------------------
111     SUBROUTINE path_allocation()
112       !----------------------------------------------------------------------
113       !
114       IMPLICIT NONE
115       !
116       ALLOCATE( pos( dim1, num_of_images ) )
117       !
118       ALLOCATE( posold(   dim1, num_of_images ) )
119       ALLOCATE( grad(     dim1, num_of_images ) )
120       ALLOCATE( grad_pes( dim1, num_of_images ) )
121       ALLOCATE( tangent(  dim1, num_of_images ) )
122       !
123       ALLOCATE( pes(      num_of_images ) )
124       ALLOCATE( k(        num_of_images ) )
125       ALLOCATE( error(    num_of_images ) )
126       ALLOCATE( climbing( num_of_images ) )
127       ALLOCATE( frozen(   num_of_images ) )
128       !
129       ALLOCATE( mass(         dim1 ) )
130       ALLOCATE( elastic_grad( dim1 ) )
131       !
132       ALLOCATE( lang( dim1, num_of_images ) )
133       !
134     END SUBROUTINE path_allocation
135     !
136     !
137     !----------------------------------------------------------------------
138     SUBROUTINE path_deallocation()
139       !----------------------------------------------------------------------
140       !
141       IMPLICIT NONE
142       !
143       IF ( ALLOCATED( pos ) )          DEALLOCATE( pos )
144       IF ( ALLOCATED( posold ) )       DEALLOCATE( posold )
145       IF ( ALLOCATED( grad ) )         DEALLOCATE( grad )
146       IF ( ALLOCATED( pes ) )          DEALLOCATE( pes )
147       IF ( ALLOCATED( grad_pes ) )     DEALLOCATE( grad_pes )
148       IF ( ALLOCATED( k ) )            DEALLOCATE( k )
149       IF ( ALLOCATED( mass ) )         DEALLOCATE( mass )
150       IF ( ALLOCATED( elastic_grad ) ) DEALLOCATE( elastic_grad )
151       IF ( ALLOCATED( tangent ) )      DEALLOCATE( tangent )
152       IF ( ALLOCATED( error ) )        DEALLOCATE( error )
153       IF ( ALLOCATED( climbing ) )     DEALLOCATE( climbing )
154       IF ( ALLOCATED( frozen ) )       DEALLOCATE( frozen )
155       IF ( ALLOCATED( lang ) )         DEALLOCATE( lang )
156       !
157       IF ( ALLOCATED( fix_atom_pos ) )     DEALLOCATE( fix_atom_pos )
158       !
159     END SUBROUTINE path_deallocation
160     !
161END MODULE path_variables
162