1!
2! Copyright (C) 2002-2013 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!
9!=----------------------------------------------------------------------------=!
10!
11MODULE path_input_parameters_module
12!
13!=----------------------------------------------------------------------------=!
14!
15!  this module contains
16!  1) the definition of all input parameters for NEB
17!  2) the definition of namelist PATH
18!  3) routines that allocate/deallocate data needed in input
19!  Based upon original NEB implementation ( C.S. 17/10/2003 )
20!
21!=----------------------------------------------------------------------------=!
22  !
23  USE kinds,      ONLY : DP
24  !
25  IMPLICIT NONE
26  !
27  SAVE
28  !
29!=----------------------------------------------------------------------------=!
30! BEGIN manual
31!
32!
33! * DESCRIPTION OF THE INPUT FILE
34!  (to be given as standard input)
35!
36!  The input file has the following layout:
37!
38!     &PATH
39!       path_parameter_1,
40!       path_parameter_2,
41!       .......
42!       path_parameter_Lastone
43!     /
44!     ATOMIC_SPECIES
45!      slabel_1 mass_1 pseudo_file_1
46!      slabel_2 mass_2 pseudo_file_2
47!      .....
48!     PATH_ATOMIC_POSITIONS
49!      alabel_1  px_1 py_1 pz_1
50!      alabel_2  px_2 py_2 pz_2
51!      .....
52!     CARD_3
53!     ....
54!     CARD_N
55!
56!  -- end of input file --
57!
58! ... variables added for "path" calculations
59!
60  INTEGER :: nat = 1
61  REAL(DP) :: alat
62  !
63  CHARACTER(len=80) :: restart_mode
64  ! specify how to start/restart the simulation
65  CHARACTER(len=80) :: restart_mode_allowed(3)
66  DATA restart_mode_allowed / 'from_scratch', 'restart', 'reset_counters' /
67  !
68  INTEGER :: nstep_path
69  !
70  CHARACTER(len=80) :: string_method = 'neb'
71  ! 'neb' traditional neb as described by Jonsson
72  !  'sm' strings method
73  CHARACTER(len=80) :: string_method_scheme_allowed(2)
74  DATA string_method_scheme_allowed / 'neb', 'sm' /
75  !
76  INTEGER :: input_images = 0
77  !
78  INTEGER :: num_of_images = 0
79  !
80  CHARACTER(len=80) :: CI_scheme = 'no-CI'
81  ! CI_scheme = 'no-CI' | 'auto' | 'manual'
82  ! set the Climbing Image scheme
83  ! 'no-CI'       Climbing Image is not used
84  ! 'auto'        Standard Climbing Image
85  ! 'manual'      the image is selected by hand
86  !
87  CHARACTER(len=80) :: CI_scheme_allowed(3)
88  DATA CI_scheme_allowed / 'no-CI', 'auto', 'manual' /
89  !
90  LOGICAL :: first_last_opt = .false.
91  LOGICAL :: minimum_image  = .false.
92  LOGICAL :: use_masses     = .false.
93  LOGICAL :: use_freezing   = .false.
94  LOGICAL :: fixed_tan      = .false.
95  !
96  CHARACTER(len=80) :: opt_scheme = 'quick-min'
97  ! minimization_scheme = 'quick-min' | 'damped-dyn' |
98  !                       'mol-dyn'   | 'sd'
99  ! set the minimization algorithm
100  ! 'quick-min'   projected molecular dynamics
101  ! 'sd'          steepest descent
102  ! 'broyden'     broyden acceleration
103  ! 'broyden2'    broyden acceleration - better ?
104  ! 'langevin'    langevin dynamics
105  !
106  CHARACTER(len=80) :: opt_scheme_allowed(5)
107  DATA opt_scheme_allowed / 'quick-min', 'broyden', 'broyden2', 'sd', 'langevin' /
108  !
109  REAL (DP)  :: temp_req = 0.0_DP
110  ! meaningful only when minimization_scheme = 'sim-annealing'
111  REAL (DP)  :: ds = 1.0_DP
112  !
113  REAL (DP)  :: k_max = 0.1_DP, k_min = 0.1_DP
114  !
115  REAL (DP)  :: path_thr = 0.05_DP
116  !
117  LOGICAL      :: lfcpopt              = .FALSE.
118  REAL(DP)     :: fcp_mu               = 0.0_DP
119  CHARACTER(8) :: fcp_relax            = 'lm'
120  ! 'lm':    line minimisation
121  ! 'mdiis': MDIIS algorithm
122  CHARACTER(len=8) :: fcp_relax_allowed(2)
123  DATA fcp_relax_allowed / 'lm', 'mdiis' /
124  REAL(DP)     :: fcp_relax_step       = 0.1_DP
125  REAL(DP)     :: fcp_relax_crit       = 0.001_DP
126  INTEGER      :: fcp_mdiis_size       = 4
127  REAL(DP)     :: fcp_mdiis_step       = 0.2_DP
128  REAL(DP)     :: fcp_tot_charge_first = 0.0_DP
129  REAL(DP)     :: fcp_tot_charge_last  = 0.0_DP
130  !
131  !
132  NAMELIST / PATH / &
133                    restart_mode, &
134                    string_method, nstep_path, num_of_images, &
135                    CI_scheme, opt_scheme, use_masses,    &
136                    first_last_opt, ds, k_max, k_min, temp_req,          &
137                    path_thr, fixed_tan, use_freezing, minimum_image, &
138                    lfcpopt, fcp_mu, fcp_relax, fcp_relax_step, fcp_relax_crit, &
139                    fcp_mdiis_size, fcp_mdiis_step, &
140                    fcp_tot_charge_first, fcp_tot_charge_last
141!
142!    ATOMIC_POSITIONS
143!
144        REAL(DP), ALLOCATABLE :: pos(:,:)
145        INTEGER, ALLOCATABLE :: typ(:)
146        !
147!
148!   CLIMBING_IMAGES
149!
150      LOGICAL, ALLOCATABLE :: climbing( : )
151! ----------------------------------------------------------------------
152
153CONTAINS
154
155  SUBROUTINE allocate_path_input_ions( num_of_images )
156    !
157    INTEGER, INTENT(in) :: num_of_images
158    !
159    IF ( allocated( pos ) ) DEALLOCATE( pos )
160    IF ( allocated( typ ) ) DEALLOCATE( typ )
161    !
162    ALLOCATE( pos( 3*nat, num_of_images ) )
163    ALLOCATE( typ( nat ) )
164    !
165    pos(:,:) = 0.0
166    !
167    RETURN
168    !
169  END SUBROUTINE allocate_path_input_ions
170  !
171  SUBROUTINE deallocate_path_input_ions()
172    !
173    IF ( allocated( pos ) ) DEALLOCATE( pos )
174    IF ( allocated( typ ) ) DEALLOCATE( typ )
175    !
176    IF ( allocated( climbing ) ) DEALLOCATE( climbing )
177    !
178    RETURN
179    !
180  END SUBROUTINE deallocate_path_input_ions
181  !
182!=----------------------------------------------------------------------------=!
183!
184END MODULE path_input_parameters_module
185!
186!=----------------------------------------------------------------------------=!
187